home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173bbas.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1990-10-28  |  138KB  |  3,948 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack'   ' DA081003
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  Macro          1320  Check/execute macro
  18. '  AnswerIt        200  Answer the telephone when it rings
  19. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  20. '  BadChar         455  Check user name for invalid characters
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  23. '  CheckRatio    20096  Test upload/download ratio
  24. '  CheckMacro     1242  Checks for macro and processes
  25. '  CopyRight        97  Display RBBS-PC's copyright notice
  26. '  DEFALTU        9600  Write out the user's defaults
  27. '  DenyAccess     1386  Downgrade security so access denied
  28. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  29. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  30. '  EditALine      2618  Edits a single line
  31. '  EditDef         120  Edit configuration parameters
  32. '  FileNameCheck 20240  Matches file name to a prefix & extension
  33. '  GetArc        20140  Handle request for verbose listing
  34. '  GetCommand      101  Get RBBS-PC's node id from command line
  35. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  36. '  GoIdle           90  Release resources when waiting for keyboard input
  37. '  KillMsg        3952  Delete old or unnecessary messages
  38. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  39. '  LineEdit       3700  Edit a line while minimizing string space consumption
  40. '  LogError      13660  Log error message to CALLERS file
  41. '  LPrnt          1480  Subroutine to write to local display
  42. '  MLInit            8  Handle MultiLink initialization/de-initialization
  43. '  MsgProt        2055  Sets protection for a message
  44. '  MessageTo      2018  Sets who a message is to
  45. '  PageLen        5200  Change page length
  46. '  ParseIt        1637  Parses a string
  47. '  PassWrd         660  Verify user & message passwords
  48. '  PopCmdStack    1650  Get user input, 1st checking command stack
  49. '  PScrn          1483  Print to display
  50. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  51. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  52. '  QuickTPut1     1478  Outputs short string following by CR LF
  53. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  54. '  RecoverMsg    10410  Recover a deleted message
  55. '  RemNonAlf      5100  Removes non-alpha characters from a string
  56. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  57. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  58. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  59. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  60. '  SetThread      4554  Set up request for threading thru messages
  61. '  SkipLine       1485  Write a # of blank lines to the communications port
  62. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  63. '  SecViolation   1380  Process a security violation
  64. '  SysMenu         112  Displays sysop menu/status
  65. '  SysopChat      4773  Sysop and caller chat
  66. '  TestRel         336  Tests for Reliable connect
  67. '  TGet           1498  Read a line from the communications port
  68. '  TPut           1396  Write a line to the communications port
  69. '  Trim            105  Strip leading and trailing blanks from a string
  70. '  TrimTrail       107  Strip off specified string off end of another string
  71. '  UntilRight    12878  Ask a question until user says answer is right
  72. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  73. '  VarInit         109  Initialize system variables
  74. '  ViewHelp       1330  Processes help command
  75. '  WhoCheck       2250  Checks whether a user exists in user file
  76. '  WhosOn         9801  Report status of each node - who's on
  77. '  WordInFile    10976  Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. 8 '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  NAME    -- MLInit
  85. '
  86. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                     CYLCE TIME
  88. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  89. '                                     A DOOR OR DOS REMOTELY
  90. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  92. '              ZDoorsTermType
  93. '              ZBaudTest!
  94. '              ZComPort$
  95. '              ZComputerType
  96. '
  97. '  OUTPUTS --  NONE
  98. '
  99. '  PURPOSE --  To test for the presence of multi-link and set
  100. '              multi link options to be compatible with RBBS-PC
  101. '
  102.       SUB MLInit (MLParm) STATIC
  103.     DEF SEG = 0
  104.     IF ZComputerType = 1 _
  105.        GOTO 10
  106.     IF NOT ZMLCom THEN _
  107.        IF ZNetworkType <> 1 THEN _
  108.           GOTO 10
  109.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF ZMultiLinkPresent = 0 THEN _
  111.        GOTO 10
  112.     ON MLParm GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF ZDoorsTermType < 1 THEN _
  116.        RETURN
  117.     DEF SEG = ZMultiLinkPresent
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = ZBaudTest!)  ******
  120.     WasAX = &H600
  121.     WasBX = ZBaudTest!   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = ZDoorsTermType) ****
  124.     WasAX = &H700 + ZDoorsTermType
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ***********
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48
  129. ' ************       MLUTIL SCMON       *************
  130.     WasAX = &HB01
  131.     WasBX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ***************
  135. 30  WasAX = &HB00       ' Turn off ML's carrier monitoring.
  136.     WasBX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       *************
  139.     WasAX = &H701       ' Change terminal type to ML type 1.
  140.     WasBX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  143. ' *******            port = 0 if ML 4.00 or greater           ******
  144.     DEF SEG = ZMultiLinkPresent
  145.     MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MultiLinkCommPort) = &H1 OR _
  148.        PEEK(MultiLinkCommPort) = &H2 THEN _
  149.        IF MultiLinkVersion > 5000 THEN _
  150.           POKE (MultiLinkCommPort),&H0 _
  151.        ELSE POKE (MultiLinkCommPort),&H9
  152. ' **********         MLUTIL ENQ         **********
  153.     WasAX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      *********
  156.     WasAX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     WasBX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         *********
  161. 60 WasAX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 WasBX = -4
  163.    IF ZComPort$ = "COM2" THEN _
  164.       WasBX = -3
  165.    IF ZComPort$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  168. 80 CALL RBBSML(WasAX,WasBX)
  169.    RETURN
  170.    END SUB
  171. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  172. '  $PAGE
  173. '
  174. '  NAME    -- GoIdle
  175. '
  176. '  INPUTS  -- ZMLCom
  177. '             ZNetworkType
  178. '
  179. '  OUTPUTS --  NONE
  180. '
  181. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  182. '              input from the communications port
  183. '
  184.       SUB GoIdle STATIC
  185.    IF ZMLCom OR ZNetworkType = 1 THEN _
  186.       CALL MLInit(5) : _
  187.       EXIT SUB
  188.    CALL GiveBack
  189.    END SUB
  190. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  NAME    -- CopyRight
  194. '
  195. '  INPUTS  --  NONE
  196. '
  197. '  OUTPUTS --  NONE
  198. '
  199. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  200. '
  201.       SUB CopyRight STATIC
  202.    ZWasA = (ZRecycleToDos OR ZDebug OR ZNodeRecIndex > 2)
  203.    IF ZWasA THEN _
  204.       EXIT SUB
  205.    WIDTH 80
  206.    REDIM ZOutTxt$(11)
  207.    ZOutTxt$(1) = "If you use RBBS-PC 17.3B, please consider contributing to" ' KG102201
  208.    ZOutTxt$(2) = ""
  209.    ZOutTxt$(3) = "             Capital PC Software Exchange"
  210.    ZOutTxt$(4) = "                 Post Office Box 6128"
  211.    ZOutTxt$(5) = "            Silver Spring, Maryland  20906"
  212.    ZOutTxt$(6) = ""
  213.    ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.3B provided" ' KG102201
  214.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  215.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  216.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  217.    CLS
  218.    KEY OFF
  219.    LOCATE ,,0
  220.    ZSnoop = -1
  221.    ZLocalUser = -1
  222.    CALL LPrnt(SPACE$(60) + "tm",1)
  223.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  224.    CALL SkipLine(1)
  225.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  226.    CALL SkipLine (1)
  227.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  228.    FOR WasI = 1 TO 10
  229.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  230.    NEXT
  231.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  232.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-90 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  233.    CALL DelayTime (8)
  234.    ZSnoop = 0
  235.    END SUB
  236. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  237. ' $PAGE
  238. '
  239. '  NAME    -- GetCommand
  240. '
  241. '  INPUTS  --     PARAMETER                    MEANING
  242. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  243. '                                  USE AS A MODEL WHEN CREATING THE
  244. '                                  .DEF FILE NAME TO BE USED BY THIS
  245. '                                  COPY OF RBBS-PC.
  246. '
  247. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  248. '                                  RBBS-PC IN THE FORM:
  249. '
  250. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  251. '
  252. '   WHERE THE OPTIONAL PARAMETERS ARE:
  253. '
  254. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  255. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  256. ' DEBUG    IS A DEBUGGING Switch
  257. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  258. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  259. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  260. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  261. '             PROGRAM
  262. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  263. '
  264. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  265. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  266. '
  267. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  268. '                                  THIS COPY OF RBBS-PC TO USE
  269. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  270. '                                  MESSAGES FILE FOR THIS "NODE"
  271. '                                  (RANGE IS 2 TO 36)
  272. '
  273. '  PURPOSE --  To get node id from command line and determine if rbbs
  274. '              is being run as a door
  275. '
  276.       SUB GetCommand (PassedDebug,NetTime$,ZNetBaud$,ZNetReliable$) STATIC
  277.       STATIC ZDebug
  278. '
  279. '
  280. ' *  GET NODE ID FROM COMMAND LINE
  281. '
  282. '
  283.       WasPM$ = COMMAND$
  284.       CALL AllCaps(WasPM$)
  285.       IF INSTR(WasPM$,"/") = 0 THEN _
  286.          GOTO 103
  287. '
  288. '
  289. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  290. '
  291. '
  292.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  293.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  294.       ZWasA = 0
  295.       FOR WasX = 1 TO LEN(CmdLine$)
  296.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  297.              ZWasA = ZWasA + 1 : _
  298.              ZSubDir$(ZWasA) = "" _
  299.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  300.       NEXT
  301.       NetTime$ = ZSubDir$(1)
  302.       IF ZWasA > 1 THEN _
  303.          ZNetBaud$ = ZSubDir$(2)
  304.       IF ZWasA > 2 THEN _
  305.          ZNetReliable$ = ZSubDir$(3)
  306.       CALL Trim(NetTime$)
  307.       CALL Trim(ZNetBaud$)
  308.       CALL Trim(ZNetReliable$)
  309. 103   ZWasA = INSTR(WasPM$,"DEBUG")
  310.       IF ZWasA > 0 THEN _
  311.          ZDebug = -1 : _
  312.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  313.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  314.       PassedDebug = ZDebug
  315.       ZWasA = INSTR(WasPM$,"LOCAL")
  316.       IF ZWasA > 0 THEN _
  317.          ZComPort$ = "COM0" : _
  318.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  319.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  320.       IF LEN(WasPM$) = 0 THEN _
  321.          WasPM$ = "-"
  322.       ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1))
  323.       IF ZNodeRecIndex < 2 THEN _
  324.          ZNodeRecIndex = 2
  325.       ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2)
  326.       IF ZNodeRecIndex > 10 THEN _
  327.          ZNodeFileID$ = LEFT$(WasPM$,1) _
  328.       ELSE ZNodeFileID$ = ZNodeID$
  329.       IF ZNodeID$ <> "1" THEN _
  330.          ZLibNodeID$ = ZNodeFileID$
  331.       IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _
  332.          ZConfigFileName$ = MID$(WasPM$,3)_
  333.       ELSE MID$(ZConfigFileName$,5,1) = WasPM$
  334.       ZOrigCnfg$ = ZConfigFileName$
  335.       END SUB
  336. 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks'
  337. ' $PAGE
  338. '
  339. '  NAME    -- Trim
  340. '
  341. '  INPUTS  --  PARAMETER                    MEANING
  342. '              TrimParm$           STRING THAT IS TO HAVE LEADING
  343. '                                  AND TRAILING BLANKS ELIMINATED FROM
  344. '
  345. '  OUTPUTS --  TrimParm$           STRING WITH NO LEADING OR TRAILING
  346. '                                   BLANKS
  347. '
  348. '  PURPOSE --  To strip leading and trailing blanks
  349. '
  350.       SUB Trim (TrimParm$) STATIC
  351.       WasL = INSTR(TrimParm$," ")
  352.       IF WasL < 1 THEN _
  353.          EXIT SUB
  354.       IF WasL = 1 THEN _
  355.          WHILE LEFT$(TrimParm$,1) = " " : _
  356.             TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _
  357.          WEND
  358.       CALL TrimTrail (TrimParm$," ")
  359.       END SUB
  360. '
  361. 107 '  $SUBTITLE: 'TrimTrail - sub to trim off trailing characters'
  362. '  $PAGE
  363. '
  364. '  NAME    --  TrimTrail
  365. '
  366. '  INPUTS  --  PARAMETER           MEANING
  367. '              TrimParm$  WHAT STRING TO Trim FROM
  368. '              TrimThis$  WHAT CHARACTER TO Trim OFF END
  369. '
  370. '  OUTPUTS --  NONE
  371. '
  372. '  PURPOSE --  To remove all occurences of a character from end of string
  373. '
  374.       SUB TrimTrail (TrimParm$,TrimThis$) STATIC
  375.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _
  376.          EXIT SUB
  377.       WasJ = LEN(TrimParm$) - 1
  378. 108   IF WasJ > 0 THEN _
  379.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _
  380.             WasJ = WasJ - 1 : _
  381.             GOTO 108
  382.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  383.       END SUB
  384. '
  385. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  386. '  $PAGE
  387. '
  388. '  NAME    --  VarInit
  389. '
  390. '  INPUTS  --  PARAMETER           MEANING
  391. '              NONE
  392. '
  393. '  OUTPUTS --  NONE
  394. '
  395. '  PURPOSE --  To initialize system variable
  396. '
  397.       SUB VarInit STATIC
  398.     ZAcknowledge$ = CHR$(6)
  399.     ZAckChar$ = "C" + _
  400.             ZAcknowledge$
  401.     ZActiveMenu$ = "B"
  402.     ZActiveMessage$ = CHR$(225)
  403.     ZBackSpace$ = CHR$(8) + _
  404.                  CHR$(32) + _
  405.                  CHR$(8)
  406.     ZBackArrow$ = CHR$(29) + _
  407.                   CHR$(32) + _
  408.                   CHR$(29)
  409.     ZBaudRates$ = "      300  450 1200 2400 4800 96001920038400"
  410.     ZBellRinger$ = CHR$(7)
  411.     ZBulletinMenu$ = ""
  412.     ZWasCL = 24
  413.     ZCancel$ = CHR$(24)
  414.     ZColorReset$ = CHR$(27) + _
  415.                    "[00;37;40m"
  416.     ZConfigFileName$ = "RBBS-PC.DEF"
  417.     ZCarriageReturn$ = CHR$(13)
  418.     ZDeletedMsg$ = CHR$(226)
  419.     ZDosVersion = 2
  420.     ZEndTransmission$ = CHR$(4)
  421.     ZEscape$ = CHR$(27)
  422.     ZExpectActiveModem = 0
  423.     ZFalse = 0
  424.     ZF1Key = 59
  425.     ZF10Key = 68
  426.     ZConfName$ = "MAIN"
  427.     CALL SetHiLite (ZTrue)
  428.     ZHomeConf$ = ""
  429.     ZInConfMenu = -1
  430.     ZLastCommand$ = "M "
  431.     ZLimitMinsPerSession = 0
  432.     ZLineFeed$ = CHR$(10)
  433.     ZLineFeeds = NOT ZFalse
  434.     ZLineEditChk$ = CHR$(9) + _
  435.                     ZLineFeed$ + _
  436.                     CHR$(11) + _
  437.                     CHR$(12) + _
  438.                     CHR$(127) + _
  439.                     CHR$(8) + _
  440.                     ZBellRinger$ + _
  441.                     CHR$(26) + _
  442.                     CHR$(227)
  443.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  444.     ZLockStatus$ = "UM UU UB UD"
  445.     ZMenuIndex = 2
  446.     ZNAK$ = CHR$(21)
  447.     ZNoAdvance = ZFalse
  448.     ZPageLength = 23
  449.     ZParseOff = ZFalse
  450.     ZPressEnter$ = " (Press [ENTER] to quit)"
  451.     ZPressEnterExpert$ = " ([ENTER] quits)"
  452.     ZPressEnterNovice$ = ZPressEnter$
  453.     ZPrivateDoor = ZFalse
  454.     ZRightMargin = 72
  455.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  456.                         ZLineFeed$
  457.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  458.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  459.                    "TY TN BN ND FS LS"
  460.     ZStartOfHeader$ = CHR$(1)
  461.     ZTimeLoggedOn$ = SPACE$(8)
  462.     ZTrue = NOT ZFalse
  463.     ZUpInc = -1
  464.     ZXOff$ = CHR$(19)
  465.     ZXOn$ = CHR$(17)
  466.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  467.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  468.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  469.     ZWasLG$(1) = "Registration Check Failed"
  470.     ZWasLG$(2) = "Sysop name attempted"
  471.     ZWasLG$(3) = "Locked out attempt"
  472.     ZWasLG$(4) = "Password Attempt Failed"
  473.     ZWasLG$(5) = "Auto Lockout done"
  474.     ZWasLG$(6) = "Name in use on another Node!"
  475.     ZWasLG$(7) = ""
  476.     ZWasLG$(8) = "Locked reason read!"
  477.     ZWasLG$(9) = "Expired Registration"
  478.     END SUB
  479. '
  480. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  481. '  $PAGE
  482. '
  483. '  NAME    --  SysMenu
  484. '
  485. '  INPUTS  --  PARAMETER           MEANING
  486. '
  487. '  OUTPUTS --  NONE
  488. '
  489. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  490. '
  491.     SUB SysMenu STATIC
  492.     ZLocalUser = ZTrue
  493.     ZSnoop = ZTrue
  494.     ZNonStop = ZTrue
  495.     CALL CheckTime (TIMER, ZDelay!, 1)
  496.     CLS
  497.     ZStopInterrupts = ZTrue
  498.     ZBypassTimeCheck = ZTrue
  499.     CALL BufFile ("MENU0",WasX)
  500.     ZNonStop = ZFalse
  501.     ZBypassTimeCheck = ZFalse
  502.     ZLocalUser = ZFalse
  503.     IF NOT ZOK THEN _
  504.        CALL LPrnt("MENU0 not on default drive",1)
  505.     LOCATE 2,18
  506.     CALL LPrnt(LEFT$(ZVersionID$,8),0)
  507.     LOCATE 2,42
  508.     CALL LPrnt(ZNodeID$,0)
  509.     LOCATE 2,60
  510.     WasX$ = DATE$
  511.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  512.     LOCATE 2,74
  513.     CALL LPrnt(LEFT$(TIME$,5),0)
  514.     IF ZFMSDirectory$ <> "" THEN _
  515.        LOCATE 6,76 : _
  516.        CALL LPrnt("YES",0)
  517.     IF ZExtendedLogging THEN _
  518.        LOCATE 8,76 : _
  519.        CALL LPrnt("YES",0)
  520.     IF ZFossil THEN _
  521.        LOCATE 10,76 : _
  522.        CALL LPrnt("YES",0)
  523.     LOCATE 12,75 : _
  524.     CALL LPrnt(ZComPort$,0)
  525.     LOCATE 14,75
  526.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  527.     IF ZDebug THEN _
  528.        LOCATE 22,76 : _
  529.        CALL LPrnt("Yes",0)
  530.     END SUB
  531. '
  532. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  533. '  $PAGE
  534. '
  535. '  NAME    -- EditDef
  536. '
  537. '  INPUTS  --     PARAMETER                    MEANING
  538. '
  539. '  OUTPUTS --                          OUTPUT STRING
  540. '
  541. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  542. '
  543.       SUB EditDef STATIC
  544.       ZAllOpts$ = ZMainCmds$ + _
  545.                   ZFileCmd$ + _
  546.                   ZUtilCmds$ + _
  547.                   ZLibCmds$ + _
  548.                   ZGlobalCmnds$ + _
  549.                   ZSysopCmds$
  550.       ZHelpExtension$ = "." + _
  551.                         ZHelpExtension$
  552.       ZCompressedExt$ = ZDefaultExtension$
  553.       ZWasQ = INSTR(ZDefaultExtension$,".")
  554.       IF ZWasQ > 0 THEN _
  555.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  556.       ZCurDirPath$ = ZDirPath$
  557.       ZBegMain = 1
  558.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  559.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  560.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  561.       ZHelp$(3) = ZHelpPath$ + _
  562.                  ZHelp$(3)
  563.       ZHelp$(4) = ZHelpPath$ + _
  564.                  ZHelp$(4)
  565.       ZHelp$(7) = ZHelpPath$ + _
  566.                  ZHelp$(7)
  567.       ZHelp$(9) = ZHelpPath$ + _
  568.                  ZHelp$(9)
  569.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  570.                      Extension$,ZTrue)
  571.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  572.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  573.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  574.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  575.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  576.      ZDR1$ = ZFG1Def$
  577.      ZDR2$ = ZFG2Def$
  578.      ZDR3$ = ZFG3Def$
  579.      ZDR4$ = ZFG4Def$
  580.      IF ZSubParm = -62 THEN _
  581.         EXIT SUB
  582.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  583.      IF ZLocalUserMode THEN _
  584.         ZRecycleToDos = ZTrue
  585.      ZEchoer$ = ZDefaultEchoer$
  586.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  587.         ZScreenOutMsg$ = ZStartOfHeader$
  588.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  589.      IF ZMaxWorkVar < 13 THEN _
  590.         ZMaxWorkVar = 13
  591. '
  592. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  593. '
  594.     IF ZMainFMSDir$ <> "" THEN _
  595.        ZFMSDirectory$ = ZDirPath$ + _
  596.                         ZMainFMSDir$ + _
  597.                         "." + _
  598.                         ZMainDirExtension$ : _
  599.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  600.        ZLibDir$ = ZLibDirPath$ + _
  601.                             ZMainFMSDir$ + _
  602.                             "." + _
  603.                             ZLibDirExtension$
  604.     ZUpcatHelp$ = ZHelpPath$ + _
  605.                   ZUpcatHelp$ + _
  606.                   ZHelpExtension$
  607.     IF ZSubDirCount < 1 THEN _
  608.        GOTO 123
  609.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  610.        INPUT #2,ZSubDir$
  611.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  612.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  613.                                  "\" _
  614.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  615.     NEXT
  616.     GOTO 125
  617. 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1
  618.        ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _
  619.                                ":"
  620.     NEXT
  621.     ZSubDirCount = LEN(ZDnldDrives$) - 1
  622. '
  623. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  624. '
  625. 125 ZUpldDirCheck$ = ZUpldDir$
  626.     ZSubDirCount = ZSubDirCount + 1
  627.     IF ZUpldToSubdir THEN _
  628.        ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _
  629.                                "\" _
  630.     ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _
  631.                                  ":"
  632.     ZUpldDir$ = ZUpldDir$ + _
  633.                         "." + _
  634.                         ZMainDirExtension$
  635.     CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found)
  636.     ZCanDnldFromUp = (Found > 0)
  637.     ZUpldDir$ = ZUpldPath$ + _
  638.                         ZUpldDir$
  639. 126 CLOSE #2
  640.     IF ZLibDrive$ <> "" THEN _
  641.        ZLibType = 1
  642.     ZSubParm = -10
  643.     CALL Carrier
  644.     IF ZSubParm = -1 THEN _
  645.        IF ZLibDrive$ <> "" THEN _
  646.           CALL ChangeDir (ZLibDrive$ + _
  647.                          "\") : _
  648.           CALL KillWork (ZLibWorkDiskPath$ + _
  649.                         ZLibNodeID$ + _
  650.                         "DK*.ARC") : _
  651.                         ZErrCode = 0
  652. '
  653. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  654. '
  655. 128 IF ZNetworkType = 2 THEN _
  656.        ZWasCN$ = SPACE$(535) : _
  657.        CALL InitIO(ZWasA)
  658.        END SUB
  659. '
  660. 129 '  $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes'
  661. '  $PAGE
  662. '
  663. '  NAME    -- ASCIICodes
  664. '
  665. '  INPUTS  --     PARAMETER                    MEANING
  666. '                 LeftParen$           MARKS BEGINNING OF #
  667. '                 RightParen$          MARKS END OF #
  668. '                 Strng$                INPUT STRING
  669. '
  670. '  OUTPUTS --    Strng$                OUTPUT STRING
  671. '
  672. '  PURPOSE -- To allow a config string to have any ascii values.
  673. '             characters not enclosed taken as is.  Enclosed
  674. '             characters interpreted as value of ascii code.
  675. '             (e.g. "123[32]4" is interpreted as "123 4").
  676. '
  677.     SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC
  678.     IF LEN(Strng$) < 1 THEN _
  679.        EXIT SUB
  680.     Start = 1
  681.     WasL = LEN(Strng$)
  682.     ZUserIn$ = Strng$ + _
  683.          LeftParen$
  684.     WasX = INSTR(ZUserIn$,LeftParen$)
  685.     NewString$ = ""
  686.     WHILE Start <= WasL
  687.        NewString$ = NewString$ + _
  688.                     MID$(ZUserIn$,Start,WasX - Start)
  689.        WasY = INSTR(WasX,ZUserIn$,RightParen$)
  690.        IF WasY > 0 THEN _
  691.           WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _
  692.           NewString$ = NewString$ + _
  693.                        CHR$(WasK) : _
  694.           Start = WasY + 1 _
  695.        ELSE NewString$ = NewString$ + _
  696.                          MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _
  697.             Start = WasL + 1
  698.        WasX = INSTR(Start,ZUserIn$,LeftParen$)
  699.     WEND
  700.     Strng$ = NewString$
  701.     END SUB
  702. 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection'
  703. ' $PAGE
  704. '
  705. '  NAME    -- AnswerIt
  706. '
  707. '  INPUTS  --     PARAMETER                    MEANING
  708. '                 ZSubParm = 1           WAIT FOR PHONE TO RING
  709. '                          = 2           CONTINUE LOOKING FOR CONNECT
  710. '                          = 3           RENTRY AFTER FUNCTION KEY
  711. '                          = 4           GO ON LINE IMMEDIATELY
  712. '                 ZBG                    LOCAL DISPLAY'S BACKGROUND
  713. '                 ZBorder                LOCAL DISPLAY'S BORDER COLOR
  714. '                 ZComPort$              COMMUNICATIONS PORT NAME
  715. '                 ZComputerType          TYPE OF COMPUTER RUNNING ON
  716. '                 ZDumbModem             NON-HAYES TYPE MODEM FLAG
  717. '                 ZExtendedLogging       EXTENDED CALLERS LOG FLAG
  718. '                 ZFG                    LOCAL DISPLAY'S FOREGROUND
  719. '                 ZModemAnswerCmd$       COMMAND TO ANSWER PHONE
  720. '                 ZModemCntlReg          LOCATION WasOF MODEM CNTRL. REG
  721. '                 ZModemCountRingsCmd$   COMMAND TO COUNT PHONE RINGS
  722. '                 ZModemInitBaud$        BAUD AT WHICH TO OPEN COMM.
  723. '                 ZModemResetCmd$        COMMAND TO RESET THE MODEM
  724. '                 ZModemStatusReg        LOCATION OF MODEM STATUS REG
  725. '                 ZPrinter               FLAG TO PRINT ON LOCAL PRT.
  726. '                 ZRequiredRings         NUMBER OF RINGS TO ANSWER ON
  727. '                 ZSnoop                 FLAG TO DISPLAY ON LOCAL PC
  728. '                 ZSysopNext             FLAG TO GIVE SYSOP CONTROL
  729. '
  730. '  OUTPUTSS --    BaudTest!              BAUD RATE TO SET RS232 AT
  731. '                 ZEightBit              PARITY INDICATOR
  732. '                 ZReliableMode          INDICATES MODEM-SUPPLIED
  733. '                                        "ERROR-FREE" Protocol ACTIVE
  734. '                 ZSubParm          = 1  Carrier DETECT Found (I.E.
  735. '                                        MODEM AUTO-ANSWERED).
  736. '                                   = 2  ANSWERED THE PHONE AND
  737. '                                        Carrier DETECT OCCURRED.
  738. '                                   = 3  SYSOP HIT "ESC" KEY ON THE
  739. '                                        LOCAL KEYBOARD.
  740. '                                   = 4  ANSWERED THE PHONE BUT NO
  741. '                                        Carrier WAS DETECTED.
  742. '                                   = 5  COMM. BUFFER OVERFLOW.
  743. '                                   = 6  FUNCTION KEY PRESSED ON THE
  744. '                                        LOCAL KEYBOARD.
  745. '
  746. '  PURPOSE -- To detect incoming call and establish connection.
  747. '
  748.       SUB AnswerIt STATIC
  749.       ZErrCode = 0
  750.       ZReliableMode = ZFalse
  751.       ZFF = ZSubParm
  752.       ZSubParm = 0
  753.       ON ZFF GOTO 201,324,245,320
  754. '
  755. '
  756. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  757. '
  758. '
  759. 201 ZSubParm = -10
  760.     CALL Carrier
  761.     IF ZSubParm = 0 THEN _
  762.        GOTO 210
  763. '
  764. '
  765. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  766. '
  767. '
  768.     IF ZFossil THEN _
  769.        State = 0 : _
  770.        CALL FosDTR(ZComPort,State) _
  771.     ELSE OUT ZModemCntlReg,&H4
  772.     CALL DelayTime (ZModemInitWaitTime)
  773. '
  774. '
  775. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  776. '
  777. '
  778.     IF ZFossil THEN _
  779.        State = 1 : _
  780.        CALL FosDTR(ZComPort,State) _
  781.     ELSE OUT ZModemCntlReg,&H0
  782.     CALL DelayTime (ZModemInitWaitTime)
  783. 210 IF ZPrivateDoor THEN _
  784.        CALL Transfer : _
  785.        GOTO 235
  786.     CALL OpenCom(ZModemInitBaud$,",N,8,1")
  787. 220 CALL AMorPM
  788. 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _
  789.                     ZNodeID$ + " up " + ZTime$ + " on " + DATE$)
  790. 235 ZEightBit = ZTrue
  791.     ZSubParm = -10
  792.     CALL Carrier
  793.     IF ZSubParm = 0 AND _
  794.        ZExitToDoors THEN _
  795.        CALL ReadProf : _
  796.        ZSubParm = 1 : _
  797.        GOTO 335
  798.     IF ZSubParm = 0 AND _
  799.        ZExpectActiveModem THEN _
  800.        ZBaudTest! = VAL(ZNetBaud$) : _
  801.        CALL TestRel (ZNetReliable$) : _
  802.        GOTO 328
  803.     IF ZExpectActiveModem OR _
  804.        ZExitToDoors THEN _
  805.        ZSubParm = 4 : _
  806.        EXIT SUB
  807.     IF ZSubParm = 0 THEN _
  808.        ConnectDelay! = TIMER + ZMaxCarrierWait : _
  809.        GOTO 324
  810.     PCJr = ZFalse
  811.     IF ZComputerType = 2 AND _
  812.        ZComPort$ = "COM1" AND _
  813.        ZModemStatusReg = 1022 THEN _
  814.        ZModemGoOffHookCmd$ = CHR$(14) + _
  815.                                    "P" : _
  816.        PCJr = ZTrue
  817.     CALL SysMenu
  818.     IF PCJr THEN _
  819.        ZOutTxt$ = CHR$(14) + _
  820.             "I" _
  821.     ELSE ZOutTxt$ = ZModemResetCmd$
  822.     CALL ModemPut (ZOutTxt$)
  823.     CALL DelayTime (ZModemInitWaitTime)
  824.     IF PCJr THEN _
  825.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'ZWasS MODEM COMMAND IDENTIFIER
  826.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'ZWasS MODEM
  827.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'ZWasS MODEM
  828.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  829.     ELSE ZOutTxt$ = ZModemInitCmd$
  830.     CALL ModemPut (ZOutTxt$)
  831.     IF PCJr THEN _
  832.        ZOutTxt$ = CHR$(14) + _
  833.             "F 4" : _
  834.        CALL ModemPut (ZOutTxt$)
  835.     RingBack = ZFalse
  836.     LOCATE 16,55
  837.     IF ZRequiredRings = 0 THEN _
  838.        CALL LPrnt("WAITING FOR CARRIER",0) : _
  839.        GOTO 237
  840.     IF MID$(ZModemInitCmd$, _
  841.           INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  842.        CALL LPrnt("RING BACK SYSTEM",0) : _
  843.        RingBack = ZTrue : _
  844.        GOTO 236
  845.     CALL LPrnt(" WAITING FOR RING ",0)
  846. 236 LOCATE 16,76 : _
  847.     CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  848. 237 LOCATE 18,76
  849.     IF ZDosANSI THEN _
  850.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  851.     ELSE CALL LPrnt ("YES",0)
  852.     COLOR ZFG,ZBG,ZBorder
  853.     LOCATE 20,56
  854. '
  855. '
  856. ' *  GET READY TO ANSWER INCOMMING CALL:
  857. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  858. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  859. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  860. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  861. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  862. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  863. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  864. '
  865. '
  866.     WasQQ = 255
  867.     WasI = INSTR(ZModemInitCmd$,"S0")
  868.     IF WasI = 0 OR PCJr THEN _
  869.        GOTO 239
  870.     IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
  871.        WasQQ = 0 : _
  872.        ZBlk = WasQQ
  873.     ZSecsUsedSession! = TIMER
  874.     ZSubParm = 1
  875.     CALL Line25
  876.     RingAnswer = ZTrue
  877.     IF RingBack THEN _
  878.        RingAnswer = ZFalse
  879. 239 RingBackWaitStart! = 0
  880.     IF RingBack THEN _
  881.        RingBackWaitStart! = TIMER : _
  882.        COLOR 7,0,0 _
  883.     ELSE COLOR ZFG,ZBG,ZBorder
  884. 240 IF ZSysopNext THEN _
  885.        ZSubParm = 3 : _
  886.        EXIT SUB
  887. '
  888. '
  889. ' * WAIT FOR INCOMING CALLS
  890. '
  891. '
  892.     ScreenCleared = ZFalse
  893. 245 InactiveDelay! = TIMER + (60 * ZRecycleWait)
  894.     NoCall = ZTrue
  895.     CALL FlushCom (ModemResponse$)
  896.     ModemResponse$ = ""
  897. 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _
  898.        GOTO 274
  899.        CALL FindFKey
  900.        IF ZSubParm < 0 THEN _
  901.           EXIT SUB
  902. 250    IF ZKeyPressed$ = ZEscape$ THEN _
  903.           ZSubParm = 3 : _
  904.           EXIT SUB
  905.        IF ZKeyPressed$ <> "" THEN _
  906.           GOTO 235
  907. 260    IF RingBackWaitStart! > 0 THEN _
  908.           CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
  909.           IF TempElapsed! > 45 THEN _
  910.              RingBackWaitStart! = 0 : _
  911.              RingBackCount = 0 : _
  912.              RingAnswer = ZFalse: _
  913.              IF RingBack THEN _
  914.                LOCATE 20,56 : _
  915.                CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  916. 265    CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2)
  917.        IF TempElapsed! > 120 AND NOT ScreenCleared THEN _
  918.           LOCATE ,,0 : _
  919.           CLS : _
  920.           ZWasCL = 1 : _
  921.           ScreenCleared = ZTrue : _
  922.           ZSecsUsedSession! = TIMER
  923.        IF ZTimeToDropToDos! > 0 THEN _
  924.           IF ZOldDate$ <> DATE$ THEN _
  925.           IF TIMER => ZTimeToDropToDos! AND _
  926.              TIMER < 86340 THEN _      ' Skip btw 23:59 and 00:00
  927.                 ZSubParm = 7 : _
  928.                 EXIT SUB
  929. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  930.           ZRequiredRings > 0 THEN _
  931.           GOTO 276
  932. 270    IF ZRecycleWait > 0 THEN _
  933.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  934.           IF TempElapsed! <= 0 THEN _
  935.              ZSubParm = 8 : _
  936.              EXIT SUB
  937.        CALL FlushCom (WasX$)
  938.        IF LEN(WasX$) > 0 THEN _
  939.           ModemResponse$ = ModemResponse$ + WasX$ : _
  940.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  941.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  942.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  943.     IF RingDetected AND ZRequiredRings > 0 THEN _
  944.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  945.        RingDetected = ZFalse : _
  946.        GOTO 276
  947.     CALL GoIdle
  948.     GOTO 247
  949. 274 IF NOT RingBack THEN _
  950.        IF ConnectDetected THEN _
  951.           GOTO 321
  952.     IF ZRequiredRings = 0 THEN _
  953.        CALL DelayTime (3) : _
  954.        GOTO 321
  955. '
  956. '
  957. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  958. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  959. ' * "RING BACK."
  960. '
  961. '
  962. 276 CALL EofComm (Char)
  963.     IF Char <> -1 THEN _
  964.        CALL FlushCom(WasX$) : _
  965.        IF ZSubParm = - 1 THEN _
  966.           EXIT SUB
  967.     IF PCJr THEN _
  968.        GOTO 320
  969.     ZOutTxt$ = ZModemCountRingsCmd$
  970.     CALL ModemPut (ZOutTxt$)
  971.     CALL DelayTime (ZModemCmdDelayTime)
  972. 290 CALL FlushCom(WasX$)
  973.     IF ZSubParm = -1 THEN _
  974.        EXIT SUB
  975. 291 IF LEN(WasX$) = 0 THEN _
  976.        GOTO 310
  977. 292 IF INSTR(WasX$,"0") < 1 THEN _
  978.        GOTO 293
  979.     WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4)
  980. 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _
  981.        RingAnswer = ZTrue
  982. 300 RingBackCount = VAL(WasX$)
  983.     ZWasQ = RingBackCount + 1
  984.     IF (NOT RingAnswer) THEN _
  985.        ZWasQ = 0
  986. 305 LOCATE 20,56
  987.     CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
  988. 310 IF (RingBackCount + 1 < ZRequiredRings) OR _
  989.        (NOT RingAnswer) THEN _
  990.        GOTO 239
  991. 320 IF PCJr THEN _
  992.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  993.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  994.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  995.     ELSE ZOutTxt$ = ZModemAnswerCmd$
  996.     CALL ModemPut (ZOutTxt$)
  997. '
  998. '
  999. ' *  TEST FOR Carrier PRESENT
  1000. '
  1001. '
  1002. 321 ConnectDelay! = TIMER + ZMaxCarrierWait
  1003. 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1004. 323 ZSubParm = -10
  1005.     CALL Carrier
  1006.     IF ZSubParm AND _
  1007.        TempElapsed! > 0 THEN _
  1008.        GOTO 322
  1009.     IF ZSubParm THEN _
  1010.        ZSubParm = 4 : _
  1011.        EXIT SUB
  1012.     CALL DelayTime (3)
  1013. 324 ZSubParm = 0
  1014.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1015.     IF TempElapsed! <= 0 THEN _
  1016.        CALL UpdtCalr ("Connect timeout",1) : _
  1017.        ZSubParm = 4 : _
  1018.        EXIT SUB
  1019. 325 CALL FlushCom(WasX$)
  1020.     IF ZSubParm = -1 THEN _
  1021.        IF ZErrCode = 69 THEN _
  1022.           ZSubParm = 5 : _
  1023.        EXIT SUB
  1024.     ModemResponse$ = ModemResponse$ + WasX$
  1025.     IF LEN(ModemResponse$) > 200 THEN _
  1026.        ModemResponse$ = RIGHT$(ModemResponse$,20)
  1027.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1028.     IF TempElapsed! <= 0 THEN _
  1029.        CALL UpdtCalr ("Connect timeout",1) : _
  1030.        ZSubParm = 4 : _
  1031.        EXIT SUB
  1032.     IF ZDumbModem THEN _
  1033.        ZBaudTest! = VAL(ZModemInitBaud$) : _
  1034.        GOTO 327
  1035.     IF INSTR(ModemResponse$,"FAST") THEN _
  1036.        ZBaudTest! = 19200 : _
  1037.        GOTO 327
  1038.     IF INSTR(ModemResponse$,"ONNECT") THEN _
  1039.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
  1040.        GOTO 327
  1041.     IF INSTR(ModemResponse$,"ONLINE") THEN _
  1042.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
  1043.        GOTO 327
  1044.     GOTO 324
  1045. 327 CALL TestRel (ModemResponse$)
  1046. 328 IF ZBaudTest! = 0 OR ZBaudTest! = 300 THEN _
  1047.        ZBaudTest! = 300 : _
  1048.        ZBPS = -1 : _
  1049.        GOTO 331
  1050.     IF ZBaudTest! = 1200 OR ZBaudTest! = 1275 THEN _
  1051.        ZBPS = -3 : _
  1052.        GOTO 331
  1053.     IF ZBaudTest! = 2400 THEN _
  1054.        ZBPS = -4 : _
  1055.        GOTO 331
  1056.     IF ZBaudTest! = 4800 OR ZBaudTest! = 9600 THEN _
  1057.        ZBPS = -4-(ZBaudTest! /4800) : _
  1058.        GOTO 331
  1059.     IF ZBaudTest! = 19200 THEN _
  1060.        ZBPS = -7 : _
  1061.        GOTO 331
  1062.     IF ZBaudTest! = 38400 THEN _
  1063.        ZBPS = -8 : _
  1064.        GOTO 331
  1065.     GOTO 324
  1066. 331 CALL SetBaud
  1067.     ZSubParm = 2
  1068. 335 DontWrite = 0
  1069.     END SUB
  1070. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  1071. ' $PAGE
  1072. '
  1073. '  NAME    -- TestRel
  1074. '
  1075. '  INPUTS  --     PARAMETER                    MEANING
  1076. '                 Strng$                 String to check for reliable
  1077. '
  1078. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  1079. '
  1080. '  PURPOSE -- To test for reliable connect
  1081. '
  1082.     SUB TestRel (Strng$) STATIC
  1083.     ZReliableMode = ZFalse
  1084.     IF Strng$ = "" THEN _
  1085.        EXIT SUB
  1086.     IF INSTR(Strng$,"REL") OR _
  1087.        INSTR(Strng$,"R C") OR _                                      ' DA071701
  1088.        INSTR(Strng$,"ARQ") OR _
  1089.        INSTR(Strng$,"LAP") OR _
  1090.        INSTR(Strng$,"AFT") OR _
  1091.        INSTR(Strng$,"MNP") THEN _
  1092.          ZReliableMode = -1
  1093.     END SUB
  1094. 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters'
  1095. ' $PAGE
  1096. '
  1097. '  NAME    -- BadChar
  1098. '
  1099. '  INPUTS  --     PARAMETER                    MEANING
  1100. '                 PassedName$                  USER NAME
  1101. '
  1102. '  OUTPUTS --    PassedName$            USER NAME WILL CONTAIN ""
  1103. '                                       IF BAD CHARACTERS Found
  1104. '
  1105. '  PURPOSE -- To check user names for invalid characters
  1106. '
  1107.     SUB BadChar (PassedName$) STATIC
  1108.     WasJ = 1
  1109.     WasXX = LEN(PassedName$)
  1110. 457 IF WasJ > WasXX THEN _
  1111.        EXIT SUB
  1112.     WasX$ = MID$(PassedName$,WasJ,1)
  1113.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _
  1114.        PassedName$ = "" : _
  1115.        EXIT SUB
  1116.     WasJ = WasJ + 1
  1117.     GOTO 457
  1118.     END SUB
  1119. 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords'
  1120. ' $PAGE
  1121. '
  1122. '  NAME    -- PassWrd
  1123. '
  1124. '  INPUTS  --     PARAMETER                    MEANING
  1125. '                 ZSubParm         = 1      VERIFY USER PASSWORD
  1126. '                                  = 2      VERIFY MESSAGE PASSWORD
  1127. '                                  = 3      VERIFY MESSAGE PASSWORD
  1128. '                                  = 4      VERIFY MESSAGE PASSWORD
  1129. '                                  = 5      VERIFY MESSAGE PASSWORD
  1130. '
  1131. '  OUTPUTS -- ZPswdFailed                   SET TO 0 IF PASSED
  1132. '                                           SET TO -1 IF FAILED
  1133. '
  1134. '  PURPOSE -- To verify user and message passwords
  1135. '
  1136.     SUB PassWrd STATIC
  1137.     ZErrCode = 0
  1138.     ON ZSubParm GOTO 665,667,670,675,677
  1139. 665 IF ZPswdSave$ = ZPswd$ THEN _
  1140.        ZPswdFailed = 0 : _
  1141.        EXIT SUB
  1142. 667 Attempts = 0
  1143. 670 Attempts = Attempts + 1
  1144.     IF Attempts > ZAttemptsAllowed THEN _
  1145.        ZPswdFailed = ZTrue : _
  1146.        EXIT SUB
  1147. 675 ZOutTxt$ = "Enter Password"
  1148.     ZHidden = ZTrue
  1149.     CALL PopCmdStack
  1150.     IF ZSubParm < 0 THEN _
  1151.        ZPswdFailed = ZTrue : _
  1152.        EXIT SUB
  1153.     ZHidden = ZFalse
  1154.     ZWasZ$ = ZUserIn$
  1155. 677 IF LEN(ZWasZ$) > 15 THEN _
  1156.        GOTO 680
  1157.     IF ZErrCode <> 0 THEN _
  1158.        GOTO 670
  1159.     CALL AllCaps (ZWasZ$)
  1160.     ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$))
  1161.     IF ZPswdSave$ = ZWasZ$ THEN _
  1162.        ZPswdFailed = 0 : _
  1163.        ZOutTxt$ = "" : _
  1164.        EXIT SUB
  1165. 680 CALL QuickTPut1 ("Wrong password ")
  1166.     ZLastIndex = 0
  1167.     IF NOT ZMsgPswd THEN _
  1168.        CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
  1169.     GOTO 670
  1170.     END SUB
  1171. 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25'
  1172. ' $PAGE
  1173. '
  1174. '  NAME    -- Line25
  1175. '
  1176. '  INPUTS  --     PARAMETER                    MEANING
  1177. '                 ZSubParm           = 1  BUILD DISPLAY FOR LINE 25
  1178. '                                    = 2  UPDATE LINE 25
  1179. '                 ZLockStatus$            STATUS OF LOCKS IN A MULTI-
  1180. '                                         USER ENVIRONMENT OR TIME OF
  1181. '                                         DAY USER LOGGED ON OR THE
  1182. '                                         RE-CYCLED
  1183. '
  1184. '  OUTPUTS -- ZCursorLine                 CURRENT LINE ON SCREEN
  1185. '             ZCursorRow                  CURRENT ROW ON ZCursorLine
  1186.  
  1187. '
  1188. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1189. '             on the PC screen that is running RBBS-PC.
  1190. '
  1191.       SUB Line25 STATIC
  1192.       IF ZSubParm = 2 THEN _
  1193.          GOTO 950
  1194. '
  1195. '
  1196. ' *  BUILD LINE 25 DISPLAY
  1197. '
  1198. '
  1199. 949 ZLine25$ = "Node " + _
  1200.                ZNodeID$ + " " + _
  1201.                ZPageStatus$ + " " + _
  1202.                MID$("AVL ",1, -4 * ZSysopAvail) + _                  ' DA080902
  1203.                MID$("ANY ",1, -4 * ZSysopAnnoy) + _                  ' DA080902
  1204.                MID$("LPT ",1, -4 * ZPrinter) + _                     ' DA080902
  1205.                MID$("SYS ",1, -4 * ZSysopNext) + _                   ' DA080902
  1206.                MID$("XOFF ",1,-5 * ZXOffEd) + _                      ' DA080902
  1207.                MID$("CTS ",1,-4 * ZNotCTS)                           ' DA080902
  1208. '
  1209. '
  1210. ' *  LINE 25 UPDATE ROUTINE
  1211. '
  1212. '
  1213. 950 IF NOT ZSnoop THEN _
  1214.        EXIT SUB
  1215.     ZCursorLine = CSRLIN
  1216.     ZCursorRow = POS(0)
  1217.     ZWasHH = LEN(ZActiveUserName$) + _
  1218.          LEN(ZWasCI$) + _
  1219.          LEN(ZLine25$) + _
  1220.          LEN(STR$(ZUserSecLevel))                                    ' DA080902
  1221.     LOCATE 25,1
  1222.     IF ZNetworkType = 0 THEN _
  1223.        IF ZAutoDownYes THEN _
  1224.           ZLockStatus$ = " AD " + _                                  ' DA080902
  1225.                          ZTimeLoggedOn$ _
  1226.        ELSE ZLockStatus$ = SPACE$(4) + _                             ' DA080902
  1227.                            ZTimeLoggedOn$
  1228.     IF ZWasHH > 63 THEN _                                            ' DA080902
  1229.        ZWasHH = 0 _                                                  ' DA080902
  1230.     ELSE _                                                           ' DA080902
  1231.        ZWasHH = 64 - ZWasHH                                          ' DA080902
  1232.     ZLine25Hold$ = ZLine25$ + _
  1233.                     SPACE$(ZWasHH) + _                               ' DA080902
  1234.                     STR$(ZUserSecLevel) + _
  1235.                     " " + _
  1236.                     ZActiveUserName$ + _
  1237.                     " " + _
  1238.                     ZWasCI$                                          ' DA080902
  1239.     ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$      ' DA080902
  1240.     IF ZDosANSI THEN _                                               ' ML090701
  1241.        ZLine25Hold$ = ZColorReset$ + ZLine25Hold$ + ZEmphasizeOff$   ' ML090701
  1242.     CALL LPrnt(ZLine25Hold$,0)
  1243.     LOCATE ZCursorLine,ZCursorRow
  1244.     END SUB
  1245. 1238 ' $SUBTITLE: 'SearchCmd    - sub to search command list'
  1246. ' $PAGE
  1247. '
  1248. '  NAME    -- SearchCmd
  1249. '
  1250. '  INPUTS  -- PARAMETER             MEANING
  1251. '             StartPos         POSITION TO BEGIN SEARCH AT
  1252. '             ZAllOpts$        STRING TO SEARCH (COMMAND LIST)
  1253. '             ZWasZ$            WHAT TO LOOK FOR
  1254. '
  1255. '  OUTPUTS -- WhereFound   POSITION OF ZWasZ$ IN ZAllOpts$
  1256. '                           0 IF NOT Found
  1257. '
  1258. '  PURPOSE -- Searches valid command list for the requested
  1259. '             command.  If the sysop has configured RBBS-PC to
  1260. '             restrict commands to only those valid within the
  1261. '             RBBS-PC subsystem, then only those commands and
  1262. '             "GLOBAL" commands are valid.  Otherwise all commands
  1263. '             are valid from any of the RBBS-PC subsections.
  1264. '
  1265.      SUB SearchCmd (StartPos,WhereFound) STATIC
  1266. 1240 IF LEN(ZWasZ$) < 1 THEN _
  1267.         WhereFound = 0 : _
  1268.         EXIT SUB
  1269.      CALL Trim (ZWasZ$)
  1270.      CALL AllCaps (ZWasZ$)
  1271.      ZWasY$ = LEFT$(ZWasZ$,1)
  1272.      WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$)
  1273.      IF WhereFound = 0 THEN _  'Not found: decide whether to hunt further
  1274.         IF StartPos < 2 OR ZRestrictValidCmds THEN _
  1275.            GOTO 1242 _  ' fully searched or restricted
  1276.         ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further
  1277.              GOTO 1242
  1278.      IF WhereFound => ZBegLibrary THEN _
  1279.         IF WhereFound < LEN(ZAllOpts$) - 11 THEN _
  1280.            IF ZLibType = 0 THEN _
  1281.               WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _
  1282.               IF WhereFound = 0 THEN _
  1283.                  WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _
  1284.                  IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _
  1285.                     WhereFound = 0 : _
  1286.                     GOTO 1242
  1287.      IF NOT ZRestrictValidCmds THEN _
  1288.         GOTO 1242            ' everything found valid
  1289. '
  1290. '
  1291. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1292. '
  1293. '
  1294.      IF WhereFound > LEN(ZAllOpts$) - 11 THEN _
  1295.         IF ZUserSecLevel < ZOptSec(WhereFound) THEN _
  1296.            WhereFound = 0 : _
  1297.            EXIT SUB _
  1298.         ELSE GOTO 1242
  1299.      IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _
  1300.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS
  1301.      IF (WhereFound < StartPos) OR _
  1302.         (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _
  1303.         (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _
  1304.         (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _
  1305.            WhereFound = 0                 ' REJECT: NOT IN Section
  1306. 1242 IF WhereFound > 0 THEN _
  1307.         LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _
  1308.         EXIT SUB
  1309.      IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _
  1310.         EXIT SUB
  1311.      CALL Macro (ZWasZ$,Found)
  1312.      IF Found THEN _
  1313.         CALL FDMACEXE : _
  1314.         ZWasZ$ = ZUserIn$(1) : _
  1315.         GOTO 1240
  1316.      END SUB
  1317. 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process'
  1318. ' $PAGE
  1319. '
  1320. '  NAME    -- CheckMacro
  1321. '
  1322. '  INPUTS  -- PARAMETER             MEANING
  1323. '             Strng$               STRING TO CHECK IF IS A MACRO
  1324. '             ZMacroDrvPath$       DRIVE/PATH WHERE MACROS ARE
  1325. '             ZMacroExtension$     EXTENSION WasOF MACROS
  1326. '             MACRO.OFF            FORCE NO MACRO TO BE Found
  1327. '
  1328. '  OUTPUTS -- MacroFound           WHETHER A MACRO WAS Found
  1329. '             Strng$               SUBSTITUTE FOR COMMANDS
  1330. '             ZCommPortStack$      REST OF MACRO
  1331. '                                  0 IF NOT Found
  1332. '
  1333. '  PURPOSE -- Macro file is checked for security (1st line).
  1334. '             2nd line is substituted for passed string
  1335. '             and parsed.  Remaining part of macro put into
  1336. '             stack to be executed.
  1337. '
  1338.      SUB CheckMacro (Strng$,MacroFound) STATIC
  1339.      MacroFound = ZFalse
  1340.      IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _
  1341.         EXIT SUB
  1342.      IF LEN(Strng$) < ZMacroMin THEN _
  1343.         ZMacroMin = 1 : _
  1344.         EXIT SUB
  1345.      IF LEN(Strng$) = 1 THEN _
  1346.         Temp$ = Strng$ : _
  1347.         CALL AllCaps (Temp$) : _
  1348.         IF INSTR(ZAllOpts$,Temp$) > 0 THEN _
  1349.            EXIT SUB
  1350.      CALL Macro (Strng$,MacroFound)
  1351.      END SUB
  1352. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  1353. ' $PAGE
  1354. '
  1355. '  NAME    -- Macro
  1356. '
  1357. '  INPUTS  -- PARAMETER             MEANING
  1358. '             Strng$           STRING TO CHECK IF IS A MACRO
  1359. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  1360. '             ZMacroExtension$ EXTENSION OF MACROS
  1361. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  1362. '
  1363. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  1364. '             Strng$           SUBSTITUTE FOR COMMANDS
  1365. '             ZCommPortStack$  REST OF MACRO
  1366. '                              0 IF NOT Found
  1367. '
  1368. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1369. '             letter uses a command.
  1370.      SUB Macro (Strng$,MacroFound) STATIC
  1371.      MacroFound = ZFalse
  1372.      FilName$ = Strng$                                               ' KG071201
  1373.      CALL BreakFileName (FilName$,ZWasDF$,Prefix$,WasX$,ZFalse)      ' KG071201
  1374.      IF WasX$ = "" THEN _                                            ' KG071201
  1375.         FilName$ = Strng$ + ZMacroExtension$                         ' KG071201
  1376.      IF ZWasDF$ = "" THEN _                                          ' KG071201
  1377.         FilName$ = ZMacroDrvPath$ + FilName$                         ' KG071201
  1378.      CALL BadFile (FilName$,ZWasA)
  1379.      IF ZWasA > 1 THEN _
  1380.         EXIT SUB
  1381.      CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6)
  1382.      IF NOT ZOK THEN _
  1383.         EXIT SUB
  1384.      CALL ReadDir (6,1)
  1385.      IF ZErrCode > 0 THEN _
  1386.         EXIT SUB
  1387.      CALL CheckInt (ZOutTxt$)
  1388.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  1389.         EXIT SUB
  1390.      ZWasA = INSTR(ZOutTxt$,"/")
  1391.      IF ZWasA > 0 THEN _    ' Check macro contraint
  1392.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  1393.         IF RIGHT$(WasX$,1) = "/" THEN _
  1394.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  1395.               EXIT SUB _
  1396.            ELSE GOTO 1327 _
  1397.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  1398.                 EXIT SUB
  1399. 1327 ZMacroActive = ZTrue
  1400.      MacroFound = ZTrue
  1401.      ZMacroEcho = ZTrue
  1402.      END SUB
  1403. 1330 ' $SUBTITLE: 'ViewHelp    - Processes requests for help'
  1404. ' $PAGE
  1405. '
  1406. '  NAME    -- ViewHelp
  1407. '
  1408. '  INPUTS  -- PARAMETER             MEANING
  1409. '            Section             ORDER OF 1ST COMMAND IN CURRENT
  1410. '                                Section
  1411. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1412. '            HelpDefault$        HELP GET IF PRESS ENTER
  1413. '            ZHelpPath$
  1414. '            ZHelpExtension$
  1415. '            ZBegFile
  1416. '            ZBegMain
  1417. '            ZBegUtil
  1418. '            ZBegLibrary
  1419. '
  1420. '  OUTPUTS -- DISPLAYS HELP
  1421. '
  1422. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1423. '             optional menu.  Accepts help with individual commands.
  1424. '
  1425.      SUB ViewHelp (Section,GraphicDefault$,HelpDefault$) STATIC
  1426.      HelpMenu$ = ZHelpPath$ + _
  1427.                   "HELP" + _
  1428.                   ZHelpExtension$
  1429.      SotMenu = ZTrue
  1430.      IF ZWasQ > 1 THEN _
  1431.         ZAnsIndex = 2 : _
  1432.         ZLastIndex = ZWasQ: _
  1433.         FastHelp = ZTrue : _
  1434.         GOTO 1332
  1435. 1331 IF SotMenu THEN _
  1436.         ZFileName$ = HelpMenu$ : _
  1437.         GOSUB 1350 : _
  1438.         SotMenu = ZFalse
  1439.      ZAnsIndex = 1
  1440.      ZOutTxt$ = "Help with what Command (or Topic name)" + _         ' DA071701
  1441.           ZPressEnterExpert$
  1442.      ZSubParm = 1
  1443.      CALL TGet
  1444.      IF ZSubParm = -1 THEN _
  1445.         EXIT SUB
  1446.      IF ZWasQ = 0 THEN _
  1447.         EXIT SUB
  1448.      ZLastIndex = ZWasQ
  1449. 1332 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1450.      CALL AllCaps (ZWasZ$)
  1451.      IF ZWasZ$ = "?" THEN _
  1452.         ZWasZ$ = "H"
  1453.      CALL BadFile (ZWasZ$,BadFileNameIndex)
  1454.      ON BadFileNameIndex GOTO 1333,1340,1340
  1455. 1333 IF LEN(ZWasZ$) <> 1 THEN _
  1456.         GOTO 1335
  1457.      CALL SearchCmd (Section,ZFF)
  1458.      IF ZFF < 1 THEN _
  1459.         ZOK = ZFalse : _
  1460.         GOTO 1336
  1461.      IF ZFF > LEN(ZAllOpts$) - 11 THEN _
  1462.         IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _
  1463.            ZOK = ZFalse : _
  1464.            GOTO 1336 _
  1465.         ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _
  1466.              GOTO 1335 _
  1467.      ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _
  1468.           ZWasZ$ = MID$("MFU@",WasX,1) + _
  1469.                    MID$(ZOrigCommands$,ZFF,1)
  1470. 1335 ZFileName$ = ZHelpPath$ + _
  1471.                   ZWasZ$ + _
  1472.                   ZHelpExtension$
  1473.      GOSUB 1350
  1474. 1336 IF NOT ZOK THEN _
  1475.         ZOutTxt$ = "No help for " + _
  1476.              ZWasZ$ : _
  1477.         CALL QuickTPut1 (ZOutTxt$) : _
  1478.         CALL UpdtCalr (ZOutTxt$,2)
  1479.      ZAnsIndex = ZAnsIndex + 1
  1480.      IF ZAnsIndex <= ZLastIndex THEN _
  1481.         GOTO 1332
  1482.      IF FastHelp THEN _
  1483.         FastHelp = ZFalse : _
  1484.         EXIT SUB
  1485.      GOTO 1331
  1486. 1340 ZOK = ZFalse
  1487.      GOTO 1336
  1488. 1350 CALL Graphic (GraphicDefault$,ZFileName$)
  1489.      CALL BufFile (ZFileName$,WasX)
  1490.      RETURN
  1491.      END SUB
  1492. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1493. ' $PAGE
  1494. '
  1495. '  NAME    -- SecViolation
  1496. '
  1497. '  INPUTS  --     PARAMETER                    MEANING
  1498. '
  1499. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  1500. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  1501. '
  1502. '  PURPOSE -- Inform caller of security violation, augment count of
  1503. '             violations and determine whether too many occurred.
  1504. '
  1505.      SUB SecViolation STATIC
  1506.      CALL FlushKeys
  1507.      CALL BufFile (ZSecVioHelp$,WasX)
  1508.      IF NOT ZOK THEN _
  1509.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  1510.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  1511.      ZLastIndex = 0
  1512.      CALL Muzak (3)
  1513.      ZViolationsThisSession = ZViolationsThisSession + 1
  1514.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  1515.         EXIT SUB
  1516. 1385 IF ZUserFileIndex < 1 THEN _
  1517.         EXIT SUB
  1518.      ZOutTxt$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1519.      IF ZUserSecLevel <= ZMinLogonSec THEN _
  1520.         ZOutTxt$ = "" : _
  1521.         ZUserSecLevel = ZUserSecLevel - 1 _
  1522.      ELSE ZUserSecLevel = ZMinLogonSec
  1523.      ZDenyAccess = ZTrue
  1524.      END SUB
  1525. 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
  1526. ' $PAGE
  1527. '
  1528. '  NAME    -- DenyAccess
  1529. '
  1530. '  INPUTS  --     PARAMETER                    MEANING
  1531. '
  1532. '  OUTPUTS -- (USER'S RECORD)
  1533. '
  1534. '  PURPOSE -- Permanently resets user's security level when access denied
  1535. '
  1536.      SUB DenyAccess STATIC
  1537.      CALL TPut
  1538.      ZLogonErrorIndex = 5
  1539.      ZSubParm = 6
  1540.      CALL FileLock
  1541.      CALL OpenUser (HighestUserRecord)
  1542.      FIELD 5, 128 AS ZUserRecord$
  1543.      GET 5,ZUserFileIndex
  1544.      MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
  1545.      PUT 5,ZUserFileIndex
  1546.      ZSubParm = 8
  1547.      CALL FileLock
  1548.      END SUB
  1549. 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port'
  1550. ' $PAGE
  1551. '
  1552. '  NAME    -- TPut (TERMINAL PUT)
  1553. '
  1554. '  INPUTS  --     PARAMETER                    MEANING
  1555. '                     ZOutTxt$                 STRING TO WRITE TO THE
  1556. '                                              COMMUNICATIONS PORT
  1557. '                 ZSubParm = 1           SKIP A LINE BEFORE WRITING
  1558. '                                        TO THE COMMUNICATIONS PORT
  1559. '                          = 2           SKIP A LINE BEFORE WRITING
  1560. '                                        TO THE COMMUNICATIONS PORT
  1561. '                                        AND THEN SKIP TWO LINES
  1562. '                                        AFTER WRITING TO THE COMM-
  1563. '                                        UNICATIONS PORT
  1564. '                           = 3          WRITE TO THE COMMUNICATIONS
  1565. '                                        PORT AND THEN SKIP TWO LINES
  1566. '                           = 4          WRITE TO THE COMMUNICATIONS
  1567. '                                        PORT WITHOUT A CR/LF
  1568. '                           = 5          WRITE TO THE COMMUNICATIONS
  1569. '                                        PORT WITH A CR/LF
  1570. '                           = 6          RESET EVERYTHING FOR INPUT STRING
  1571. '                           = 7          RE-ENTRY AFTER HANDLING A
  1572. '                                        FUNCTION KEY
  1573. '
  1574. '  OUTPUTS --  ZSubParm = -1 Carrier HAS BEEN DROPPED
  1575. '              ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1576. '
  1577. '  PURPOSE --  Common output routine for RBBS-PC to the
  1578. '              communications port (terminal put)
  1579.       SUB TPut STATIC
  1580.       IF ZSubParm <> 7 THEN _
  1581.          Parm = ZSubParm
  1582.       ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411
  1583. '
  1584. '
  1585. ' *  COMMON OUTPUT ROUTINE
  1586. '
  1587. '
  1588. 1398 CALL SkipLine (1)
  1589.      GOTO 1405
  1590. 1399 CALL SkipLine (1)
  1591. 1400 ZCR = 1
  1592. 1403 ZCR = ZCR + 1
  1593. 1405 ZRet = ZFalse
  1594.      IF ZWasCM THEN _
  1595.         GOTO 1435
  1596. 1410 CALL FindFKey
  1597.      IF ZSubParm < 0 THEN _
  1598.         EXIT SUB
  1599. 1411 ZWasY$ = ZKeyPressed$
  1600.      ZSubParm = Parm
  1601.      IF ZLocalUser THEN _
  1602.         GOTO 1430
  1603.      CALL EofComm (Char)
  1604.      IF Char = -1 THEN _
  1605.         CALL CheckCarrier : _
  1606.         IF ZSubParm = -1 THEN _
  1607.            EXIT SUB _
  1608.         ELSE GOTO 1430
  1609.      CALL GetCom(ZWasY$)
  1610. 1425 IF ZSubParm = -1 THEN _
  1611.         EXIT SUB
  1612. 1430 IF ZWasY$ = "" THEN _
  1613.         GOTO 1435
  1614.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  1615.      GOSUB 1476
  1616.      GOTO 1435
  1617. 1433 GOSUB 1476
  1618.      IF ASC(RIGHT$(ZCommPortStack$,2)) = 13 OR _
  1619.         ZStopInterrupts THEN _
  1620.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1621.      GOTO 1471
  1622. 1434 IF ZStopInterrupts THEN _
  1623.         GOTO 1435
  1624.      ZCommPortStack$ = ""
  1625.      IF ZFossil THEN _
  1626.         CALL FOSTXPurge(ZComPort) : _
  1627.         CALL FosRXPurge(ZComPort)
  1628.      GOTO 1471
  1629. 1435 LOCATE ,,1
  1630.      CALL LPrnt (ZOutTxt$,0)
  1631. 1437 IF ZUpperCase THEN _
  1632.         IF ZWasGR <> 2 THEN _
  1633.            CALL AllCaps (ZOutTxt$)
  1634.      CALL PutCom (ZOutTxt$)
  1635. 1450 IF ZCR <> 1 THEN _
  1636.         CALL SkipLine (1) _
  1637.      ELSE IF ZCR > 1 THEN _
  1638.              CALL SkipLine (1)
  1639. 1470 ZCR = 0
  1640.      EXIT SUB
  1641. 1471 CALL SkipLine (1)
  1642.      ZStopInterrupts = ZFalse
  1643.      ZRet = ZTrue
  1644.      ZNo = ZTrue
  1645.      ZNonStop = ZFalse
  1646.      GOTO 1470
  1647. 1473 ZXOffEd = ZTrue
  1648.      GOTO 1410
  1649. 1475 ZXOffEd = ZFalse
  1650.      GOTO 1410
  1651. 1476 IF ASC(ZWasY$) < 127 THEN _
  1652.         ZCommPortStack$ = ZCommPortStack$ + ZWasY$
  1653.      RETURN
  1654.      END SUB
  1655. 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
  1656. ' $PAGE
  1657. '
  1658. '  NAME    -- QuickTPut
  1659. '
  1660. '  INPUTS  -- PARAMETER             MEANING
  1661. '             Strng$             STRING TO WRITE OUT
  1662. '             NumReturns         NUMBER OF CARRIAGE RETURNS
  1663. '
  1664. '  OUTPUTS -- NONE
  1665. '
  1666. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1667. '             different from "TPut" in the things it doesn't do:
  1668. '                A.) No function key check,
  1669. '                B.) No conversion to upper case,
  1670. '                C.) No check for carrier present
  1671. '                D.) No check for imbedded carriage return in "Strng$"
  1672. '                E.) No support for XON/XOff
  1673. '
  1674.       SUB QuickTPut (Strng$,NumReturns) STATIC
  1675.       IF ZSubParm < 0 THEN _
  1676.          EXIT SUB
  1677.       IF ZUseTPut THEN _
  1678.          ZOutTxt$ = Strng$ : _
  1679.          ZSubParm = 4 : _
  1680.          CALL TPut : _
  1681.          CALL SkipLine (NumReturns) : _
  1682.          EXIT SUB
  1683.       CALL PutCom (Strng$)
  1684.       LOCATE ,,1
  1685.       CALL LPrnt (Strng$,0)
  1686.       CALL SkipLine (NumReturns)
  1687.       END SUB
  1688.       SUB QuickTPut1 (Strng$) STATIC
  1689.       CALL QuickTPut (Strng$,1)
  1690.       END SUB
  1691. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  1692. ' $PAGE
  1693. '
  1694. '  NAME    -- LPrnt
  1695. '
  1696. '  INPUTS  -- PARAMETER             MEANING
  1697. '             Strng$        STRING TO WRITE OUT
  1698. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  1699. '
  1700. '  OUTPUTS -- NONE
  1701. '
  1702. '  PURPOSE -- Subroutine to write to the display.
  1703. '
  1704.       SUB LPrnt (Strng$,NumReturns) STATIC
  1705.       IF NOT ZSnoop THEN _
  1706.          EXIT SUB
  1707.       CALL PScrn (Strng$)
  1708.       IF ZVoiceType <> 0 AND ZTalkAll THEN _
  1709.          CALL Talk (65,Strng$)
  1710.       IF ZUseBASICWrites THEN _
  1711.          FOR WasI = 1 TO NumReturns : _
  1712.             PRINT : _
  1713.          NEXT : _
  1714.       ELSE FOR WasI = 1 TO NumReturns : _
  1715.               LOCATE ,,1 : _
  1716.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1717.               LOCATE ZWasCL,ZWasCC : _
  1718.               NEXT
  1719.       END SUB
  1720. 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display'
  1721. ' $PAGE
  1722. '
  1723. '  NAME    -- QuickLPrnt
  1724. '
  1725. '  INPUTS  -- PARAMETER             MEANING
  1726. '             Strng$        STRING TO WRITE OUT
  1727. '             Num           NUMBER OF CARRIAGE RETURNS
  1728. '
  1729. '  OUTPUTS -- NONE
  1730. '
  1731. '  PURPOSE -- Subroutine to quickly write to the display.
  1732. '             Overwrites, and puts up count
  1733.       SUB QuickLPrnt (Strng$,Num) STATIC
  1734.       IF ZSnoop THEN _
  1735.          LOCATE ,1,1 : _
  1736.          CALL Pscrn (Strng$ + STR$(Num))
  1737.       END SUB
  1738. 1483 ' $SUBTITLE: 'PScrn    - subroutine to print to the screen'
  1739. ' $PAGE
  1740. '
  1741. '  NAME    -- PScrn
  1742. '
  1743. '  INPUTS  -- PARAMETER             MEANING
  1744. '             Strng$        STRING TO WRITE OUT
  1745. '
  1746. '  OUTPUTS -- NONE
  1747. '
  1748. '  PURPOSE -- Writes to local screen regardless of whether you have
  1749. '             carrier.  Assumes have positioned cursor where you want.
  1750. '
  1751.       SUB PScrn (Strng$) STATIC
  1752.       IF Strng$ = "" THEN _
  1753.          EXIT SUB
  1754.       IF ZUseBASICWrites THEN _
  1755.          PRINT Strng$; _
  1756.       ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _
  1757.            LOCATE ZWasCL,ZWasCC
  1758.       END SUB
  1759. 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user'
  1760. ' $PAGE
  1761. '
  1762. '  NAME    -- SkipLine
  1763. '
  1764. '  INPUTS  --   PARAMETER             MEANING
  1765. '               ZLocalUser
  1766. '               ZModemStatusReg
  1767. '               NumReturns
  1768. '               ZReturnLineFeed$
  1769. '               ZSnoop
  1770. '
  1771. '  OUTPUTS -- NONE
  1772. '
  1773. '  PURPOSE -- Skip lines on the user's terminal
  1774. '
  1775.       SUB SkipLine (NumReturns) STATIC
  1776.       FOR WasI=1 TO NumReturns
  1777.           CALL PutCom (ZReturnLineFeed$)
  1778.       NEXT
  1779.       IF NOT ZSnoop THEN _
  1780.          GOTO 1486
  1781.       IF ZUseBASICWrites THEN _
  1782.          FOR WasI = 1 TO NumReturns : _
  1783.             PRINT : _
  1784.          NEXT _
  1785.       ELSE FOR WasI = 1 TO NumReturns : _
  1786.               LOCATE ,,1 : _
  1787.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1788.               LOCATE ZWasCL,ZWasCC : _
  1789.            NEXT
  1790. 1486  ZLinesPrinted = ZLinesPrinted + NumReturns
  1791.       ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns
  1792.       END SUB
  1793. 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output'
  1794. ' $PAGE
  1795. '
  1796. '  NAME    -- SetCrLf
  1797. '
  1798. '  INPUTS  --   PARAMETER          MEANING
  1799. '              ZCarriageReturn$    CARRIAGE RETURN CHARACTER
  1800. '              ZLineFeed$          LINE FEED CHARACTER
  1801. '              ZLineFeeds          LINE FEED Switch
  1802. '              ZNul$                NULL CHARACTER
  1803. '
  1804. '  OUTPUTS -- ZReturnLineFeed$   END-OF-LINE STRING
  1805. '
  1806. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1807. '             each output to the communications port with.
  1808. '
  1809.       SUB SetCrLf STATIC
  1810.       ZReturnLineFeed$ = _
  1811.          MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _
  1812.          ZNul$ + _
  1813.          MID$(ZLineFeed$,1, - (ZLineFeeds <> 0))
  1814.       END SUB
  1815. 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply'
  1816. ' $PAGE
  1817. '
  1818. '  NAME    -- TGet
  1819. '
  1820. '  INPUTS  --    PARAMETER                   MEANING
  1821. '                ZSubParm          = 1  STANDARD ENTRY
  1822. '                                  = 2  ENTRY AFTER A FUNCTION KEY
  1823. '                                         HAS BEEN HANDLED
  1824. '                                  = 3  ENTRY AFTER STACKED COMMAND
  1825. '             ZOutTxt$                        STRING TO WRITE TO THE
  1826. '                                       COMMUNICATIONS PORT
  1827. '             ZHidden                    IF THIS IS TRUE THEN ECHO
  1828. '                                       '.' INSTEAD OF ACTUAL
  1829. '                                       CHARACTER ENTERED.
  1830. '             ZForceKeyboard            IF TRUE, STACKED INPUT
  1831. '                                       IS BYPASSED AND KEYBOARD
  1832. '                                       INPUT IS READ.
  1833. '
  1834. '  OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED
  1835. '             ZUserIn$                  STRING THAT WAS ENTERED
  1836. '             ZWasQ                     NUMBER OF PARAMETERES THAT
  1837. '                                       WERE ENTERED WHICH WHERE
  1838. '                                       SEPARATED BY A SEMICOLON
  1839. '             ZUserIn$()                STRING MATRIX WITH EACH
  1840. '                                       ITEM CONTAIN THE STRING
  1841. '                                       THAT WAS ENTERED BETWEEN
  1842. '                                       SEMICOLONS.
  1843. '             ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1844. '             ZYes                      Reply IS "Y" OR "YES"
  1845. '             ZNo                       Reply IS "N" OR "NO"
  1846. '             ZNonStop                  Reply IS "NS" OR "ns"
  1847. '             ZKillMessage              Reply IS "K"
  1848. '             ZReply                    Reply IS "RE"
  1849. '
  1850. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1851. '
  1852.      SUB TGet STATIC
  1853.      MacroIndex = ZForceKeyboard
  1854.      ON ZSubParm GOTO 1500,1538,1625
  1855. '
  1856. '
  1857. ' *  COMMON INPUT ROUTINE
  1858. '
  1859. '
  1860. 1500 CALL Carrier
  1861.      IF ZSubParm = -1 THEN _
  1862.         EXIT SUB
  1863.      ZLinesPrinted = 0
  1864.      ZDisplayAsUnit = ZFalse
  1865.      InStack = ZFalse
  1866.      GOSUB 1580
  1867.      ZWasA = 0
  1868.      ZWasB = 0
  1869.      ZWasC = 0
  1870.      ZWasQ = 1
  1871.      ZStoreParseAt = 1
  1872.      Parm = 0
  1873.      ZYes = ZFalse
  1874.      ZUserIn$ = ""
  1875.      SleepWarn = ZTrue
  1876.      ZNo = ZFalse
  1877.      ZNonStop = (ZPageLength < 1)
  1878.      IF ZOutTxt$ = "" THEN _
  1879.         GOTO 1525
  1880.      IF ZHidden THEN _
  1881.         ZOutTxt$ = ZOutTxt$ + " (dots echo)"
  1882.      IF (NOT ZVerifying) OR HoldA$ = "" THEN _
  1883.         CALL ColorPrompt (ZOutTxt$) : _
  1884.         ZOutTxt$ = ZOutTxt$ + _
  1885.              MID$("? !  ",2*ZTurboKey+1,2) : _
  1886.         HoldA$ = ZOutTxt$ _
  1887.      ELSE ZOutTxt$ = HoldA$
  1888.      ZSubParm = 4
  1889.      StopSave = ZStopInterrupts
  1890.      ZStopInterrupts = ZTrue
  1891.      CALL TPut
  1892.      ZStopInterrupts = StopSave
  1893.      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1894.         EXIT SUB
  1895. 1523 IF ZPromptBell THEN _
  1896.         IF ZLocalUser THEN _
  1897.            BEEP_
  1898.         ELSE CALL PutCom(ZBellRinger$)
  1899. 1525 CALL Carrier
  1900.      IF ZSubParm = -1 THEN _
  1901.         EXIT SUB
  1902.      IF LEN(ZCommPortStack$) > 0 THEN _
  1903.         InStack = ZTrue : _
  1904.         WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _
  1905.         IF WasX > 0 THEN _
  1906.            ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _
  1907.            ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _
  1908.            GOTO 1534 _
  1909.         ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _
  1910.              ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  1911.              GOTO 1541
  1912.      IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _
  1913.         GOTO 1536
  1914. '
  1915. ' *** MACRO PROCESSING
  1916. '
  1917. 1526 CALL ReadMacro
  1918.      IF ZMacroSave > 0 THEN _
  1919.         GOTO 1500
  1920.      IF NOT ZMacroActive THEN _
  1921.         ZWasQ = 0 : _
  1922.         ZLastIndex = 0 : _
  1923.         EXIT SUB
  1924.      IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _
  1925.         GOTO 1536
  1926. 1534 ZUserIn$ = ZOutTxt$   ' Not Macro command - pass to normal processing
  1927.      IF ZMacroEcho THEN _
  1928.         ZSubParm = 4 : _
  1929.         CALL TPut
  1930.      WasX$ = ZCarriageReturn$
  1931.      GOTO 1547
  1932. 1536 IF ZLocalUser THEN _
  1933.         GOTO 1537
  1934.      '  CALL FindFKey: _
  1935.      '  IF ZSubParm < 0 THEN _
  1936.      '     EXIT SUB _
  1937.      '  ELSE GOTO 1538
  1938.      CALL EofComm (Char)
  1939.      IF Char <> -1 THEN _
  1940.         CALL GetCom(ZWasY$) : _
  1941.         IF ZSubParm = -1 THEN _
  1942.            EXIT SUB _
  1943.         ELSE GOTO 1541
  1944. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  1945.      IF TempElapsed! < 30 THEN _
  1946.         IF TempElapsed! <= 0 THEN _
  1947.            CALL UpdtCalr ("Sleep disconnect",1) : _
  1948.            ZSubParm = -1 : _
  1949.            ZNo = ZTrue : _
  1950.            ZSleepDisconnect = ZTrue : _
  1951.            EXIT SUB _
  1952.         ELSE IF SleepWarn THEN _
  1953.                 SleepWarn = ZFalse : _
  1954.                 ZOutTxt$ = "Auto-Logoff in 30 seconds..." : _        ' DA071701
  1955.                 CALL RingCaller
  1956.      CALL FindFKey
  1957.      IF ZSubParm < 0 THEN _
  1958.         EXIT SUB
  1959. 1538 ZWasY$ = ZKeyPressed$
  1960.      IF ZWasY$ <> "" THEN _
  1961.         GOTO 1545
  1962.      SendRemote = ZTrue
  1963.      CALL GoIdle
  1964.      GOTO 1525
  1965. 1541 SendRemote = ZRemoteEcho
  1966.      IF ZTestParity THEN _
  1967.         GOTO 1542
  1968.      IF ZWasY$ = CHR$(127) THEN _
  1969.         GOTO 1635
  1970.      GOTO 1545
  1971. 1542 IF ZWasY$ = "" THEN _
  1972.         ZWasY$ = " "
  1973.      IF ASC(ZWasY$) = 141 THEN _
  1974.         OUT ZLineCntlReg,&H1A : _
  1975.         ZEightBit = ZFalse : _
  1976.         ZTestParity = ZFalse : _
  1977.         ZWasGR = ZFalse
  1978.      ZWasY$ = CHR$(ASC(ZWasY$) AND 127)
  1979. 1545 WasX$ = ZWasY$
  1980.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  1981.         GOTO 1635
  1982.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  1983.         GOTO 1525
  1984.      IF ZWasY$ = "^" THEN _
  1985.         GOTO 1525
  1986.      IF ZWasY$ = ZCarriageReturn$ THEN _
  1987.         GOTO 1547 _
  1988.      ELSE GOSUB 1550
  1989.      IF ZTurboKey < 1 THEN _
  1990.         GOTO 1546
  1991.      IF ZWasY$ = " " THEN _
  1992.         ZWasY$ = ""
  1993.      IF ZWasY$ <> "/" THEN _
  1994.         ZUserIn$ = ZWasY$ : _
  1995.         ZWasY$ = ZCarriageReturn$ : _
  1996.         WasX$ = ZWasY$ : _
  1997.         GOTO 1547
  1998.      ZTurboKey = 0
  1999.      GOTO 1525
  2000. 1546 IF LEN(ZUserIn$) => 512 THEN _
  2001.         ZOutTxt$ = "Input too long!" : _
  2002.         ZSubParm = 5 : _
  2003.         CALL TPut : _
  2004.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2005.            EXIT SUB _
  2006.         ELSE GOTO 1500
  2007.      ZUserIn$ = ZUserIn$ + _
  2008.           ZWasY$
  2009.      GOTO 1525
  2010. 1547 ZTurboKey = ZFalse          ' Carriage Return Handler
  2011.      ZHidden = ZFalse
  2012.      IF ZNoAdvance THEN _
  2013.         ZNoAdvance = ZFalse : _
  2014.         GOTO 1575 _
  2015.      ELSE CALL LPrnt (ZCrLf$,0) : _
  2016.           GOSUB 1551 : _
  2017.           GOTO 1570
  2018. 1550 IF ZLogonActive THEN _
  2019.         IF (ZWasY$ = " " OR ZWasY$ = ";") AND LEN(ZUserIn$) > 0 AND _ ' MB073001
  2020.            RIGHT$(ZUserIn$,1) <> " " AND RIGHT$(ZUserIn$,1) <> ";" THEN _
  2021.               Parm = Parm + 1 : _
  2022.               ZLogonActive = (Parm < 3) : _
  2023.               ZHidden = (Parm = 2) : _
  2024.               CALL LPrnt(WasX$,0) : _
  2025.               GOTO 1551
  2026.      IF ZHidden AND (WasX$ <> " ") THEN _
  2027.         WasX$ = "."
  2028.      CALL LPrnt(WasX$,0)
  2029. 1551 IF NOT SendRemote THEN _
  2030.         RETURN
  2031.      IF ZHidden AND (WasX$ <> " ") THEN _
  2032.         WasX$ = "."
  2033. 1553 CALL PutCom (WasX$)
  2034.      RETURN
  2035. 1570 IF SendRemote THEN _
  2036.         IF ZLineFeeds THEN _
  2037.            CALL PutCom (ZLineFeed$)
  2038. 1575 IF LEN(ZUserIn$) > 4000 THEN _
  2039.         ZOutTxt$ = "Try again, " + _
  2040.              ZFirstName$ : _
  2041.         ZSubParm = 5 : _
  2042.         CALL TPut : _
  2043.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2044.            EXIT SUB _
  2045.         ELSE GOTO 1500
  2046.      IF ZParseOff THEN _
  2047.         ZParseOff = ZFalse : _
  2048.         GOTO 1620
  2049.      CALL ParseIt
  2050.      IF ZWasQ = 1 THEN _
  2051.         GOTO 1622
  2052.      GOTO 1625
  2053. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2054.      RETURN
  2055. 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$
  2056.      ZWasQ = 1
  2057. 1622 IF ZUserIn$ = "" THEN _
  2058.         ZWasQ = 0 : _
  2059.         ZHidden = ZFalse : _
  2060.         GOTO 1628
  2061. 1625 IF LEN(ZUserIn$) < 4 THEN _
  2062.         WasX$ = LEFT$(ZUserIn$,3): _
  2063.         CALL AllCaps (WasX$) : _
  2064.         IF WasX$ = "Y" OR WasX$ = "YES" THEN _
  2065.            ZYes = ZTrue _
  2066.         ELSE IF WasX$ = "N" OR WasX$ = "NO" OR WasX$ = "A" THEN _
  2067.                 ZNo = ZTrue _
  2068.              ELSE IF WasX$ = "RE" THEN _
  2069.                      ZReply = ZTrue : _
  2070.                      GOTO 1628 _
  2071.                   ELSE IF WasX$ = "K" THEN _
  2072.                           ZKillMessage = ZTrue : _
  2073.                           GOTO 1628
  2074.      ZHidden = ZFalse
  2075. 1628 CALL VerifyAns
  2076.      IF NOT ZOK THEN _
  2077.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  2078.         GOTO 1500
  2079.      HoldA$ = ""
  2080.      ZForceKeyboard = ZFalse
  2081.      IF ZMacroSave > 0 THEN _
  2082.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  2083.         ZMacroSave = 0 : _
  2084.         GOTO 1632
  2085.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  2086.         CALL WipeLine (38) : _
  2087.         IF NOT ZNo THEN _
  2088.            GOTO 1632 _
  2089.         ELSE ZWasQ = 0 : _
  2090.              ZMacroTemplate$ = "" : _
  2091.              ZDistantTGet = 0 : _
  2092.              ZNo = ZFalse : _
  2093.              GOTO 1633
  2094.      IF ZMacroActive THEN _
  2095.         ZLastIndex = ZWasQ : _
  2096.         FirstIndex = 1: _
  2097.         ZMacroActive = NOT EOF(6) : _                                ' KG021501
  2098.         EXIT SUB
  2099.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  2100.         EXIT SUB
  2101.      IF MacroIndex THEN _
  2102.         MacroIndex = 1 _
  2103.      ELSE MacroIndex = ZAnsIndex
  2104.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  2105.      IF Found THEN _
  2106.         EXIT SUB
  2107.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  2108.      IF Found THEN _
  2109.         ZStoreParseAt = ZAnsIndex : _
  2110.         GOTO 1525
  2111.      EXIT SUB
  2112. 1632 ZUserIn$ = ""
  2113.      ZForceKeyboard = ZFalse
  2114. 1633 GOSUB 1580
  2115.      ZWasQ = 1
  2116.      GOTO 1525
  2117. 1635 IF LEN(ZUserIn$) = 0 THEN _
  2118.         GOTO 1525
  2119.      IF ZLogonActive THEN _
  2120.         IF INSTR(" ;",RIGHT$(ZUserIn$,1)) > 0 THEN _
  2121.            Parm = Parm - 1
  2122.      ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
  2123.      CALL LPrnt(ZLocalBksp$,0)
  2124.      IF SendRemote THEN _
  2125.         CALL PutCom(ZBackSpace$)
  2126.      GOTO 1525
  2127.      END SUB
  2128. 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
  2129. ' $PAGE
  2130. '
  2131. '  NAME    -- RingCaller
  2132. '
  2133. '  INPUTS  --     PARAMETER                    MEANING
  2134. '                 ZOutTxt$                           STRING TO EMPHASIZE
  2135. '
  2136. '  OUTPUTS --  none
  2137. '
  2138. '  PURPOSE --  Rings the users bell before and after string
  2139. '              (but not snooping sysop) and adds emphasis around
  2140. '              message sent.
  2141. '
  2142.      SUB RingCaller STATIC
  2143.      WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
  2144.      CALL PutCom (ZBellRinger$)
  2145.      CALL LPrnt (WasX$,0)
  2146.      ZSubParm = 2
  2147.      ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
  2148.      CALL TPut
  2149.      CALL PutCom (ZBellRinger$)
  2150.      CALL LPrnt (WasX$,0)
  2151.      END SUB
  2152. 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string'
  2153. ' $PAGE
  2154. '
  2155. '  NAME    -- ParseIt
  2156. '
  2157. '  INPUTS  --     PARAMETER                    MEANING
  2158. '                 ZUserIn$                     STRING TO PARSE
  2159. '
  2160. '  OUTPUTS --  ZWasQ                           NUMBER PARSED
  2161. '              ZUserIn$()                      PARSED STRINGS
  2162. '
  2163. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2164. '              if exists, otherwise space, otherwise comma
  2165. '
  2166.      SUB ParseIt STATIC
  2167.      ZWasA = INSTR(ZUserIn$,";")
  2168.      IF ZWasA > 0 THEN _
  2169.         ParseChar$ = ";" _
  2170.      ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _
  2171.              CALL Trim (ZUserIn$) : _
  2172.              WasX$ = ZUserIn$ : _
  2173.              ZWasA = INSTR(ZUserIn$,"  ") : _
  2174.              WHILE ZWasA > 0 : _
  2175.                 ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _
  2176.                      MID$(ZUserIn$,ZWasA + 1) : _
  2177.                 ZWasA = INSTR(ZWasA,ZUserIn$,"  ") : _
  2178.              WEND : _
  2179.              ZWasA = INSTR(ZUserIn$," ") : _
  2180.              IF ZWasA > 1 THEN _
  2181.                 ParseChar$ = " " _
  2182.              ELSE ZWasA = INSTR(ZUserIn$,",") : _
  2183.                   ParseChar$ = ","
  2184.      IF ZWasA > 1 THEN _
  2185.         GOTO 1639
  2186.      ZWasDF$ = ZUserIn$
  2187.      CALL AllCaps (ZWasDF$)
  2188.      IF ZWasDF$ = "NS" THEN _
  2189.          ZUserIn$ = "C" : _
  2190.          ZNonStop = ZTrue
  2191.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  2192.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  2193.      GOTO 1642
  2194. 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1)
  2195.      ZWasA = ZWasA + 1
  2196.      ZEOL = ZFalse
  2197. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  2198.      ZWasC = ZWasB-ZWasA
  2199.      IF ZWasC < 1 THEN _
  2200.         ZEOL = ZTrue : _
  2201.         ZWasC = 128
  2202.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  2203.      IF ZWasDF$ <> "" THEN _
  2204.         ZWasQ = ZWasQ + 1 : _
  2205.         ZStoreParseAt = ZStoreParseAt + 1 : _
  2206.         ZUserIn$(ZStoreParseAt) = ZWasDF$ : _
  2207.         CALL AllCaps(ZWasDF$) : _
  2208.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";") : _
  2209.         IF WasX > 0 THEN _
  2210.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC) : _
  2211.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4) : _
  2212.            IF ZWasQ > 0 AND WasX < 7 THEN _
  2213.               ZWasQ = ZWasQ - 1 : _
  2214.               ZStoreParseAt = ZStoreParseAt - 1
  2215.      IF NOT ZEOL AND ZWasQ < 50 THEN _
  2216.         ZWasA = ZWasB + 1 : _
  2217.         GOTO 1640
  2218.      IF ParseChar$ <> ";" THEN _
  2219.         ZUserIn$ = WasX$
  2220. 1642 ZStackC = ZFalse
  2221.      END SUB
  2222. 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check'
  2223.      SUB PopCmdStack STATIC
  2224.      CALL CheckCarrier
  2225.      IF ZSubParm = -1 THEN _
  2226.         ZLastIndex = 0 : _
  2227.         ZWasQ = 0 : _
  2228.         EXIT SUB
  2229.      ZWasQ = 1
  2230. 1651 IF ZAnsIndex < ZLastIndex THEN _
  2231.         ZAnsIndex = ZAnsIndex + 1 : _
  2232.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  2233.         IF MID$(ZLastCommand$,2,1) <> " " AND (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _ ' KG070901
  2234.            GOTO 1651 _
  2235.         ELSE ZSubParm = 3 : _
  2236.              CALL TGet : _
  2237.              GOTO 1652
  2238.      ZLastIndex = 0
  2239.      ZAnsIndex = 1
  2240.      ZSubParm = 1
  2241.      ZSearchingAll = ZFalse
  2242.      CALL TGet
  2243.      ZLastIndex = ZWasQ
  2244. 1652 IF ZStoreParseAt > ZLastIndex THEN _
  2245.         IF ZLastIndex > 0 THEN _
  2246.            ZLastIndex = ZStoreParseAt
  2247.      ZStackC = ZFalse
  2248.      ZParseOff = ZFalse
  2249.      END SUB
  2250. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  2251. ' $PAGE
  2252. '
  2253. '  NAME    -- SetBaud
  2254. '
  2255. '  INPUTS  --     PARAMETER                    MEANING
  2256. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  2257. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2258. '                                 BAUD RATE TO THE USER'S BAUD
  2259. '                                 RATE (INDEPENDENT OF THE BAUD
  2260. '                                 RATE USED TO OPEN THE COMM. PORT)
  2261. '
  2262. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2263. '            RATE              PCjr         PC AND XT
  2264. '              50             2237             2304
  2265. '              75             1491             1536
  2266. '             110             1017             1047
  2267. '             134.5            832              857
  2268. '             150              746              768
  2269. '             300              373              384
  2270. '             600              186              192
  2271. '            1200               93               96
  2272. '            1800               62               64
  2273. '            2000               56               58
  2274. '            2400               47               48
  2275. '            3600               31               32
  2276. '            4800               23               24
  2277. '            7200          not available         16
  2278. '            9600          not available         12
  2279. '           19200          not available          6
  2280. '           38400               "                 3
  2281. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2282. '
  2283. '  PURPOSE -- To set the baud rate in the RS232 interface
  2284. '             inpependent of the baud rate the communications port
  2285. '             was opened at
  2286. '
  2287.       SUB SetBaud STATIC
  2288.      IF NOT ZKeepInitBaud THEN _
  2289.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  2290.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  2291.      CALL Trim (ZTalkToModemAt$)
  2292.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  2293.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  2294.                             ZTalkToModemAt$
  2295.      IF ZEightBit THEN_
  2296.         Parity = 2 : _                                    ' No PARITY
  2297.         DataBits = 3 : _                                  ' 8 DATA BITS
  2298.         StopBits = 0 _                                    ' 1 STOP BIT
  2299.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  2300.           DataBits = 2 : _                                ' 7 DATA BITS
  2301.           StopBits = 0                                    ' 1 STOP BIT
  2302.      ComSpeed! = VAL(ZTalkToModemAt$)
  2303.      IF ComSpeed! > 19200 THEN _
  2304.         IF FOSSIL THEN _
  2305.            WasI = &H9600 _
  2306.         ELSE WasI = 19200 _
  2307.      ELSE WasI = ComSpeed!
  2308.      IF ZFossil THEN _
  2309.         CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
  2310.         EXIT SUB
  2311.      IF ComSpeed! = 2400 THEN _
  2312.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  2313.      ELSE IF ComSpeed! = 1200 THEN _
  2314.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  2315.      ELSE IF ComSpeed! = 9600 THEN _
  2316.         ZBaudRateDivisor = &HC _
  2317.      ELSE IF ComSpeed! = 300 THEN _
  2318.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  2319.      ELSE IF ComSpeed! = 450 THEN _
  2320.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  2321.      ELSE IF ComSpeed! = 4800 THEN _
  2322.         ZBaudRateDivisor = &H18 _
  2323.      ELSE IF ComSpeed! = 19200 THEN _
  2324.         ZBaudRateDivisor = &H6 _
  2325.      ELSE IF ComSpeed! = 38400 THEN _
  2326.         ZBaudRateDivisor = &H3
  2327.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  2328.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  2329.      LineCntlStatus = INP(ZLineCntlReg)
  2330.      MSBSave = INP(ZMSB)
  2331.      OUT ZMSB,0
  2332.      OUT ZLineCntlReg,LineCntlStatus OR 128
  2333.      OUT ZLSB,LeastSignifByte
  2334.      OUT ZMSB,MostSignifByte
  2335.      OUT ZLineCntlReg,LineCntlStatus
  2336.      OUT ZMSB,MSBSave
  2337.      END SUB
  2338. 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
  2339. ' $PAGE
  2340. '
  2341. '  NAME    -- MessageTo
  2342. '
  2343. '  INPUTS  --     PARAMETER                    MEANING
  2344. '              HighestUserRecord
  2345. '
  2346. '  OUTPUTS --  MsgTo$              Who message is to
  2347. '              RcvrRecNum         User record # of who to
  2348. '
  2349. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2350. '
  2351.      SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  2352.      Temp$ = MsgFrom$
  2353.      CALL Trim (Temp$)
  2354. 2020 IF MsgTo$ <> "" THEN _
  2355.         GOTO 2032
  2356.      ZOutTxt$ = "To [A]ll,S)ysop, or name"
  2357.      CALL SkipLine (1)
  2358.      ZParseOff = ZTrue
  2359.      GOSUB 2033
  2360.      IF LEN(ZUserIn$) > 30 THEN _
  2361.         CALL QuickTPut1 ("30 Char. Max") : _
  2362.         GOTO 2020
  2363. 2030 Found = ZTrue
  2364.      RcvrRecNum = 0
  2365.      IF ZWasQ = 0 THEN _
  2366.         MsgTo$ = "ALL" _
  2367.      ELSE CALL AllCaps (ZUserIn$) : _
  2368.           IF ZUserIn$ = "A" THEN _
  2369.              MsgTo$ = "ALL" : _
  2370.              EXIT SUB _
  2371.           ELSE IF ZUserIn$ = "S" THEN _
  2372.              MsgTo$ = "SYSOP" _
  2373.           ELSE MsgTo$ = ZUserIn$
  2374. 2032 IF MsgTo$ <> "ALL" THEN _
  2375.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  2376.            ZWasDF = INSTR(MsgTo$+" @"," @") : _                      ' KG052201
  2377.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _               ' KG052201
  2378.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  2379.            IF NOT Found THEN _
  2380.               ZLastIndex = 0 : _
  2381.               RcvrRecNum = 0 : _                                     ' KG060901
  2382.               IF NOT ZReply THEN _
  2383.                  ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2384.                  ZTurboKey = -ZTurboKeyUser : _
  2385.                  ZLastIndex = 0 : _
  2386.                  GOSUB 2033 : _
  2387.                  ZWasZ$ = ZUserIn$(1) : _
  2388.                  CALL AllCaps (ZWasZ$) : _
  2389.                  IF ZWasZ$ <> "C" THEN _
  2390.                     MsgTo$ = "" : _
  2391.                     IF ZWasZ$ <> "Q" THEN _
  2392.                        GOTO 2020
  2393.      IF MsgTo$ = Temp$ THEN _
  2394.         ZOutTxt$ = "Msg would be from and to SAME PERSON!  Really do this (Y,[N])" : _
  2395.         ZLastIndex = 0 : _
  2396.         GOSUB 2033 : _
  2397.         IF NOT ZYes THEN _
  2398.            MsgTo$ = ""
  2399.      EXIT SUB
  2400. 2033 CALL PopCmdStack
  2401.      IF ZSubParm < 0 THEN _
  2402.         EXIT SUB
  2403.      RETURN
  2404.      END SUB
  2405. 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message'
  2406. ' $PAGE
  2407. '
  2408. '  NAME    -- MsgProt
  2409. '
  2410. '  INPUTS  --     PARAMETER                    MEANING
  2411. '                 MsgTo$
  2412. '                 Found
  2413. '
  2414. '  OUTPUTS --  ZPswd$                Protection desired
  2415. '
  2416. '  PURPOSE --  Sets protection desired for a new message
  2417. '
  2418.      SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC
  2419.      IF MsgTo$ = "ALL" THEN _
  2420.         GOTO 2090
  2421. 2060 ZOutTxt$ = "Make message p(U)blic, p(R)ivate, (P)assword protected, (H)elp"
  2422.      IF MsgPswd$ = "^READ^" THEN _
  2423.         DefaultProt$ = "R" : _
  2424.         GOTO 2065
  2425.      IF LEFT$(MsgPswd$,1) = "!" THEN _
  2426.         DefaultProt$ = "P" _
  2427.      ELSE _
  2428.         DefaultProt$ = "U"
  2429. 2065 MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]"
  2430.      ZTurboKey = -ZTurboKeyUser
  2431.      GOSUB 2096
  2432.      IF ZWasQ = 0 THEN _
  2433.         ZUserIn$(ZAnsIndex) = DefaultProt$
  2434.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  2435.      CALL AllCaps (ZWasZ$)
  2436.      ON INSTR("RUPH",ZWasZ$) GOTO 2075,2090,2075,2070
  2437.      GOTO 2060
  2438. '
  2439. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2440. '
  2441. 2070 CALL BufFile (ZHelp$(3),WasX)
  2442.      GOTO 2060
  2443. '
  2444. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2445. '
  2446. 2075 IF MsgTo$ = "ALL" THEN _
  2447.         CALL QuickTPut1 ("Msg to ALL cannot be private") : _
  2448.         GOTO 2060
  2449.      IF ZWasZ$ = "P" THEN _
  2450.         GOTO 2088
  2451. 2081 CALL QuickTPut1 ("Sending private mail to " + MsgTo$)           ' DA071701
  2452. 2084 MsgPswd$ = "^READ^"
  2453.      EXIT SUB
  2454. 2085 ZOutTxt$ = "Password"
  2455.      GOSUB 2096
  2456.      IF ZWasQ = 0 THEN _
  2457.         IF LEFT$(MsgPswd$,1) = "!" THEN _
  2458.            MsgPswd$ = MID$(MsgPswd$,2) : _
  2459.            CALL QuickTPut1 ("Password is " + MsgPswd$) : _
  2460.            RETURN _
  2461.         ELSE _
  2462.         GOTO 2085
  2463.      IF LEN(ZUserIn$) > WasL THEN _
  2464.         CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _
  2465.         GOTO 2085
  2466.      IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
  2467.         CALL QuickTPut1 ("Password can't begin with '!'") : _
  2468.         GOTO 2085
  2469.      RETURN
  2470. '
  2471. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2472. '
  2473. 2088 ZOutTxt$ = "Receiver(s) MUST know password to read msg.  Use password (Y/[N])" ' DA071701
  2474.      GOSUB 2093
  2475.      IF NOT ZYes THEN _
  2476.         GOTO 2070
  2477.      WasL = 14
  2478.      WasA1$ = "!"
  2479.      GOSUB 2085
  2480.      CALL AllCaps (ZUserIn$)
  2481.      GOTO 2092
  2482. '
  2483. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2484. '
  2485. 2090 WasL = 15
  2486.      WasA1$ = ""
  2487.      ZUserIn$ = "^KILL^"
  2488. 2092 MsgPswd$ = WasA1$ + ZUserIn$                                    ' DA071701
  2489.      EXIT SUB
  2490. 2093 ZTurboKey = -ZTurboKeyUser
  2491. 2094 ZSubParm = 1
  2492.      CALL TGet
  2493. 2095 IF ZSubParm = -1 THEN _
  2494.         EXIT SUB
  2495.      RETURN
  2496. 2096 CALL PopCmdStack
  2497.      GOTO 2095
  2498.      END SUB
  2499. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  2500. ' $PAGE
  2501. '
  2502. '  NAME    -- WhoCheck
  2503. '
  2504. '  INPUTS  --   PARAMETER                    MEANING
  2505. '              WhoFind$                User to find
  2506. '
  2507. '  OUTPUTS --  WhoFound                Whether user found
  2508. '              UserNumFound           Record # of user
  2509. '
  2510. '  PURPOSE --  Validate that user record exists.  Sysop
  2511. '              counted as found even if lack user record.
  2512. '
  2513.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  2514.      UserNumFound = 0
  2515.      IF ZStartHash <> 1 THEN _
  2516.         WhoFound = ZTrue : _
  2517.         EXIT SUB
  2518.      Work128$ = ZUserRecord$
  2519.      WhoFound = ZFalse
  2520.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  2521.                 INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0) ' KG060902
  2522.      CALL OpenUser (HighestUserRecord)
  2523.      FIELD 5, 128 AS ZUserRecord$
  2524.      IF ToSysop THEN _
  2525.         WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2526.      ELSE WasX$ = WhoFind$
  2527.      ZWasDF = INSTR(WasX$+"@","@")                                   ' KG052201
  2528.      WasX$ = LEFT$(WasX$,ZWasDF)                                     ' KG052201
  2529.      IF LEN(WasX$) > 1 THEN _
  2530.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  2531.                        0,0,HighestUserRecord,WhoFound,_
  2532.                        UserNumFound,ZWasSL)
  2533.      LSET ZUserRecord$ = Work128$
  2534.      IF NOT WhoFound THEN _
  2535.         IF ToSysop THEN _
  2536.            WhoFound = ZTrue _
  2537.         ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  2538.      END SUB
  2539. 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message'
  2540. ' $PAGE
  2541. '
  2542. '  NAME    -- EditALine
  2543. '
  2544. '  INPUTS  --     PARAMETER                    MEANING
  2545. '                 WasL                        Line # to edit
  2546. '
  2547. '  OUTPUTS --  ZOutTxt$(WasL)                 Edited line
  2548. '
  2549. '  PURPOSE --  Edit a line in a message.
  2550. '
  2551.      SUB EditALine (WasL) STATIC
  2552. 2620 ZOutTxt$ = "Line #" + _
  2553.           STR$(WasL) + _
  2554.           " is:" + _
  2555.           ZReturnLineFeed$ + _
  2556.           ZOutTxt$(WasL)
  2557.      ZSubParm = 3
  2558.      CALL TPut
  2559.      GOSUB 2695
  2560.      IF NOT ZExpertUser THEN _
  2561.         CALL QuickTPut1 ("Search & replace")
  2562.      ZOutTxt$ = "Search for" + _
  2563.           ZPressEnterExpert$
  2564.      ZMacroMin = 99
  2565.      ZParseOff = ZTrue
  2566.      ZSubParm = 1
  2567.      GOSUB 2694
  2568.      IF ZWasQ = 0 THEN _
  2569.         EXIT SUB
  2570.      ZWasY$ = LEFT$(ZUserIn$,1)
  2571.      IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
  2572.         IF LEN(ZUserIn$) > 2 THEN _
  2573.            WasX = INSTR(2,ZUserIn$,ZWasY$) : _
  2574.            IF WasX < LEN(ZUserIn$) THEN _
  2575.               IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
  2576.                  ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
  2577.                  WasX = WasX - 1 : _
  2578.                  GOTO 2622
  2579.      WasX = INSTR(ZUserIn$,";")
  2580. 2622 IF WasX > 0 THEN _
  2581.         WasX$ = LEFT$(ZUserIn$,WasX-1) : _
  2582.         ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
  2583.         GOTO 2660
  2584.      WasX$ = ZUserIn$
  2585.      ZOutTxt$ = "And replace by"
  2586.      ZParseOff = ZTrue
  2587.      ZSubParm = 1
  2588.      GOSUB 2694
  2589.      ZWasY$ = ZUserIn$
  2590. 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
  2591.      IF WasX = 0 THEN _
  2592.         CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _
  2593.         GOTO 2620
  2594. 2670 ZFF = LEN(WasX$)
  2595.      WasJJ = LEN(ZWasY$)
  2596.      IF ZFF = WasJJ THEN _
  2597.         MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _
  2598.         GOTO 2620
  2599. 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1)
  2600.      ZOutTxt$(WasL) = ZWasDF$ + _
  2601.              ZWasY$ + _
  2602.              MID$(ZOutTxt$(WasL),WasX + ZFF)
  2603.      IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _
  2604.         CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$())
  2605.      GOTO 2620
  2606. 2694 CALL TGet
  2607. 2695 IF ZSubParm > -1 THEN _
  2608.         RETURN
  2609.      END SUB
  2610. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  2611. ' $PAGE
  2612. '
  2613. '  NAME    -- LineEdit
  2614. '
  2615. '  INPUTS  -- PARAMETER             MEANING
  2616. '             ZBackArrow$
  2617. '             ZBackSpace$
  2618. '             ZCarriageReturn$
  2619. '             ZLineFeed$
  2620. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  2621. '             ZLocalUser
  2622. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  2623. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  2624. '             ZRightMargin
  2625. '             ZSnoop
  2626. '             ZStopInterrupts
  2627. '             ZWaitExpired
  2628. '
  2629. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  2630. '
  2631. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2632. '             string space.
  2633. '
  2634.      SUB LineEdit (MsgLine,MaxLen) STATIC
  2635.      TabToSpace = 0                                                  ' DA060901
  2636.      LSET ZLineMes$ = ZOutTxt$(MsgLine)
  2637.      Col = LEN(ZOutTxt$(MsgLine))
  2638.      ZStopInterrupts = ZTrue
  2639.      WasXXX = MaxLen - 3
  2640.      ZWaitExpired = ZFalse
  2641.      GOTO 3782
  2642. 3720 Col = Col + 1
  2643.      ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2644. 3730 IF TabToSpace > 0 THEN _                                        ' DA060901
  2645.         WasX$ = " " : _                                              ' DA060901
  2646.         TabToSpace = TabToSpace - 1 : _                              ' DA060901
  2647.         GOTO 3750                                                    ' DA060901
  2648.      CALL FindFKey                                                   ' DA060901
  2649.      IF ZSubParm < 0 THEN _
  2650.         EXIT SUB
  2651.      WasX$ = ZKeyPressed$
  2652.      IF WasX$ = "" THEN _
  2653.         IF ZLocalUser THEN _
  2654.            GOTO 3730 _
  2655.         ELSE GOTO 3732
  2656.      IF WasX$ = ZEscape$ THEN _
  2657.         ZKeyPressed$ = WasX$ : _
  2658.         EXIT SUB
  2659.      SendRemote = ZTrue
  2660.      WasZ = INSTR(ZLineEditChk$,WasX$)
  2661.      IF WasZ < 1 THEN _
  2662.         GOTO 3750 _
  2663.      ELSE IF WasZ > 4 THEN _
  2664.              GOTO 3870 _                                             ' DA060901
  2665.      ELSE IF WasZ = 1 THEN _                                         ' DA060901
  2666.              GOTO 3810                                               ' DA060901
  2667.      IF ZLocalUser THEN _
  2668.         GOTO 3730
  2669. 3732 IF ZCommPortStack$ <> "" THEN _
  2670.         WasX$ = LEFT$(ZCommPortStack$,1) : _
  2671.         ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  2672.         GOTO 3738
  2673.      CALL EofComm (Char)
  2674.      IF Char <> -1 THEN _
  2675.         GOTO 3736
  2676.      CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2677.      IF TempElapsed! <=0 THEN _
  2678.         ZWaitExpired = ZTrue : _
  2679.         EXIT SUB
  2680. 3733 CALL Carrier
  2681.      IF ZSubParm THEN _
  2682.         EXIT SUB
  2683.      GOTO 3730
  2684. 3736 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2685. 3737 CALL GetCom (WasX$)
  2686. 3738 SendRemote = ZRemoteEcho
  2687. 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3810,3730,3730,3730, _       ' DA060901
  2688.                                    3870,3870,3870,3870,3870          ' DA060901
  2689. 3750 IF SendRemote THEN _
  2690.         CALL PutCom(WasX$)
  2691.      CALL LPrnt (WasX$, 0)
  2692.      IF WasX$ = ZCarriageReturn$ THEN _
  2693.         Col = Col - 1 : _
  2694.         GOTO 3850
  2695. 3770 IF Col > WasXXX THEN _
  2696.         IF WasX$ = " " THEN _
  2697.            CALL SkipLine (1) : _
  2698.            GOTO 3860
  2699. 3780 MID$(ZLineMes$,Col) = WasX$
  2700. 3782 IF Col < MaxLen THEN _
  2701.         GOTO 3720
  2702.      WasZ = Col
  2703. 3800 IF WasZ < 1 THEN _
  2704.         WasZ = Col-1 : _
  2705.         GOTO 3820
  2706.      IF MID$(ZLineMes$,WasZ,1) = " " THEN _
  2707.         GOTO 3820
  2708.      WasZ = WasZ - 1
  2709.      GOTO 3800
  2710. 3810 TabToSpace = 5 - (Col MOD 5)                                    ' DA060901
  2711.      GOTO 3730                                                       ' DA060901
  2712. 3820 IF (NOT ZRemoteEcho) AND (NOT ZLocalUser) THEN _
  2713.         CALL SkipLine (1) : _
  2714.         GOTO 3860
  2715.      Col = MaxLen - WasZ
  2716.      IF ZSnoop THEN _
  2717.         IF (POS(0) > Col) AND (Col > 0) THEN _
  2718.            LOCATE ,POS(0)-Col: _
  2719.            CALL LPrnt(STRING$(Col,32),0)
  2720. 3830 IF ZRemoteEcho THEN _
  2721.         CALL PutCom (STRING$(Col,8) + STRING$(Col,32))
  2722. 3840 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,WasZ)
  2723.      ZOutTxt$(MsgLine + 1) = MID$(ZLineMes$,WasZ + 1,Col)
  2724.      CALL SkipLine (1)
  2725.      GOTO 3891
  2726. 3850 IF SendRemote AND ZLineFeeds THEN _
  2727.         CALL PutCom(ZLineFeed$)
  2728. 3860 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,Col)
  2729.      GOTO 3891
  2730. 3870 IF Col = 1 THEN _
  2731.         GOTO 3730
  2732.      Col = Col-2
  2733. 3880 CALL LPrnt(ZLocalBksp$,0)
  2734. 3885 IF SendRemote THEN _
  2735.         CALL PutCom (ZBackSpace$)
  2736. 3890 GOTO 3720
  2737. 3891 CALL Carrier
  2738.      END SUB
  2739. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  2740. ' $PAGE
  2741. '
  2742. '  NAME    -- KillMsg
  2743. '
  2744. '  INPUTS  --     PARAMETER                    MEANING
  2745. '              MsgToKill                   MESSAGE NUMBER TO KILL
  2746. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  2747. '
  2748. '  OUTPUTS --  NONE
  2749. '
  2750. '  PURPOSE --  To kill/delete old or unnecessary messages
  2751. '
  2752.      SUB KillMsg (MsgToKill,ActiveMessages) STATIC
  2753. '
  2754.      FIELD #1,128 AS ZMsgRec$
  2755.      WasQX = 1
  2756. 3955 IF WasQX > ActiveMessages THEN _
  2757.         ZOutTxt$ = "No such msg #" + _
  2758.              STR$(MsgToKill) : _
  2759.         GOTO 4031
  2760.      IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
  2761.         GOTO 3970
  2762.      WasQX = WasQX + 1
  2763.      GOTO 3955
  2764. 3970 ZSubParm = 3
  2765.      CALL FileLock
  2766.      GET 1,ZMsgPtr(WasQX,1)
  2767.      IF ZUserSecLevel >= ZSecKillAny THEN _
  2768.         GOTO 4030
  2769. 3980 ZWasZ$ = MID$(ZMsgRec$,101,15)
  2770.      CALL Trim (ZWasZ$)
  2771.      IF LEN(ZWasZ$) = 0 THEN _
  2772.         GOTO 4030
  2773. 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
  2774.         CALL ChkMsgName (MsgToCaller,MsgFromCaller) : _              ' KG090402
  2775.         IF (MsgFromCaller or MsgToCaller) THEN _
  2776.            GOTO 4030 _
  2777.         ELSE ZMsgPswd = ZTrue : _
  2778.              ZAttemptsAllowed = 0 : _
  2779.              ZOutTxt$ = "Only sender & receiver can kill" : _
  2780.              GOTO 4031
  2781. 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _
  2782.         ZWasZ$ = MID$(ZWasZ$,2)
  2783. 4010 ZPswdSave$ = ZWasZ$ + _
  2784.                       SPACE$(15 - LEN(ZWasZ$))
  2785.      ZAttemptsAllowed = 1
  2786.      ZMsgPswd = ZTrue
  2787.      CALL PassWrd
  2788.      IF ZPswdFailed THEN _
  2789.         GOTO 4031
  2790. 4030 MID$(ZMsgRec$,116,1) = ZDeletedMsg$
  2791.      PUT 1,LOC(1)
  2792.      ZSubParm = 4
  2793.      CALL FileLock
  2794.      ZOutTxt$ = "Killed Msg # " + _
  2795.           STR$(MsgToKill)
  2796.      CALL UpdtCalr (ZOutTxt$,1)
  2797. 4031 ZSubParm = 5
  2798.      CALL TPut
  2799.      END SUB
  2800. 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading'
  2801. ' $PAGE
  2802. '
  2803. '  NAME    -- SetThread
  2804. '
  2805. '  INPUTS  --     PARAMETER                    MEANING
  2806. '                 CurMsgNum                 Current message number
  2807. '                 CurSubj$                  Current message subject
  2808. '
  2809. '  OUTPUTS --  ZUserIn$()                   Search msg by string
  2810. '              ZWasQ                        0 if thread cancelled
  2811. '
  2812. '  PURPOSE --  Find out how the caller wants to thread -
  2813. '              i.e. search messages by matching subject -
  2814. '              forward from current, back from current,
  2815. '              or forward from top of messages
  2816. '
  2817.      SUB SetThread (CurMsgNum,CurSubj$) STATIC
  2818.      IF ZWasQ > 1 THEN _
  2819.         ZWasZ$ = ZUserIn$(2) : _
  2820.         GOTO 4657
  2821. 4656 ZOutTxt$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2822.      ZTurboKey = -ZTurboKeyUser
  2823.      ZSubParm = 1
  2824.      CALL TGet
  2825.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2826.         EXIT SUB
  2827.      ZWasZ$ = ZUserIn$(1)
  2828. 4657 ZWasZ$ = LEFT$(ZWasZ$,1)
  2829.      WasX = INSTR("+-1",ZWasZ$)
  2830.      IF WasX = 0 THEN _
  2831.         GOTO 4656
  2832.      ZUserIn$(1) = "R"
  2833.      IF WasX = 1 THEN _
  2834.         CurMsgNum = CurMsgNum + 1 _
  2835.      ELSE IF WasX = 2 THEN _
  2836.              CurMsgNum = CurMsgNum - 1 _
  2837.           ELSE CurMsgNum = 1 : _
  2838.                ZWasZ$ = "+"
  2839.      ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$
  2840.      IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _
  2841.         ZUserIn$(2) = CurSubj$ _
  2842.      ELSE ZUserIn$(2) = MID$(CurSubj$,4)
  2843.      ZUserIn$(2) = LEFT$(ZUserIn$(2) + "  ",22)
  2844.      ZLastIndex = 3
  2845.      ZAnsIndex = 1
  2846.      ZWasQ = 3
  2847.      END SUB
  2848. 4773 ' $SUBTITLE: 'SysopChat - chat with sysop'
  2849. ' $PAGE
  2850. '
  2851. '  NAME    -- SysopChat
  2852. '
  2853. '  INPUTS  --     PARAMETER                    MEANING
  2854. '  OUTPUTS --  ZWasCM                     True if chat active
  2855. '
  2856. '  PURPOSE --  Lets sysop chat interactively with caller
  2857. '
  2858.      SUB SysopChat STATIC
  2859.      ZWasCM = ZTrue
  2860.      TimeChatStarted! = TIMER
  2861.      ZSubParm = 1
  2862.      CALL Line25
  2863.      ZOutTxt$(2) = ""
  2864. 4775 CALL LineEdit (1,72)
  2865.      IF ZKeyPressed$ = ZEscape$ OR _
  2866.         ZSubParm < 0 THEN _
  2867.         GOTO 4777
  2868.      ZOutTxt$(1) = ""
  2869.      IF ZOutTxt$(2) <> "" THEN _
  2870.         ZOutTxt$ = ZOutTxt$(2) : _
  2871.         ZOutTxt$(1) = ZOutTxt$(2) : _
  2872.         ZOutTxt$(2) = "" _
  2873.      ELSE ZOutTxt$ = ""
  2874.      ZSubParm = 4
  2875.      CALL TPut
  2876.      IF ZSubParm > -1 THEN _
  2877.         GOTO 4775
  2878. 4777 ZWasCM = 0
  2879.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  2880.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  2881.      IF NOT ZLocalUser THEN _
  2882.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2883.      CALL QuickTPut("  Chat over.  BBS resuming",2)                  ' KG071301
  2884.      END SUB
  2885. 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string'
  2886. ' $PAGE
  2887. '
  2888. '  NAME    -- RemNonAlf
  2889. '
  2890. '  INPUTS  --     PARAMETER                    MEANING
  2891. '                 Strng$                   String to check
  2892. '                 MinChar                  Remove chars with this
  2893. '                                          ASCII value or lower
  2894. '                 MaxChar                  Remove chars with this
  2895. '                                          ASCII value or higher
  2896. '
  2897. '  OUTPUTS --       Strng$                 String returned
  2898. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2899. '
  2900.      SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC
  2901.      Last = LEN(Strng$)
  2902.      WasJ = 1
  2903.      WHILE WasJ <= Last
  2904.         WasK = ASC(MID$(Strng$,WasJ))
  2905.         IF WasK > MinChar AND WasK < MaxChar THEN _
  2906.            WasJ = WasJ + 1 _
  2907.         ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _
  2908.                       RIGHT$(Strng$,Last - WasJ) : _
  2909.              Last = Last - 1
  2910.      WEND
  2911.      END SUB
  2912. 5200 ' $SUBTITLE: 'PageLen - Sets lines per page'
  2913. ' $PAGE
  2914. '
  2915. '  NAME    -- PageLen
  2916. '
  2917. '  INPUTS  --     PARAMETER                    MEANING
  2918. '               ZPageLength              Current page length
  2919. '
  2920. '  OUTPUTS --   ZPageLength              New page length
  2921. '
  2922. '  PURPOSE --  Change default lines per page
  2923. '
  2924.      SUB PageLen STATIC
  2925. 5202 ZOutTxt$ = "CHANGE page length from" + _
  2926.           STR$(ZPageLength) + _
  2927.           " TO (0-255, 0=continuous)"
  2928.      CALL PopCmdStack
  2929.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2930.         CALL QuickTPut1 ("No change") : _
  2931.         EXIT SUB
  2932. 5230 CALL CheckInt (ZUserIn$(ZAnsIndex))
  2933.      IF ZErrCode <> 0 THEN _
  2934.         GOTO 5202
  2935.      IF ZTestedIntValue < 0 OR _
  2936.         ZTestedIntValue > 255 THEN _
  2937.         GOTO 5202
  2938.      ZPageLength = ZTestedIntValue
  2939.      CALL QuickTPut1 ("Page Length Set to" + STR$(ZPageLength))
  2940.      END SUB
  2941. 5507 ' $SUBTITLE: 'Baud450 -- Changes 300 baud to 450'
  2942. ' $PAGE
  2943. '  NAME    -- Baud450
  2944. '
  2945. '  INPUTS  -- PARAMETER             MEANING
  2946. '             ZBPS
  2947. '
  2948. '  OUTPUTS -- ZBPS
  2949. '
  2950. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  2951. '
  2952.      SUB Baud450 STATIC
  2953.      IF ZBPS <> -1 THEN _
  2954.         CALL QuickTPut1 ("Sorry, only 300 baud can change speed") : _
  2955.         EXIT SUB
  2956.      IF ZFossil THEN _
  2957.         CALL QuickTPut1 ("Sorry, no 450 baud under FOSSIL") : _      ' KG071301
  2958.         EXIT SUB
  2959.      ZOutTxt$ = "Change to 450 baud (Y,[N])"
  2960.      ZTurboKey = -ZTurboKeyUser
  2961.      ZSubParm = 1
  2962.      CALL TGet
  2963.      IF ZSubParm = -1 OR NOT ZYes THEN _
  2964.         EXIT SUB
  2965. 5510 CALL QuickTPut1 ("Change your baud rate to 450")
  2966.      CALL DelayTime (9)
  2967.      ZWasC = 0
  2968.      ZBPS = -2
  2969.      CALL SetBaud
  2970.      ZOutTxt$ = " and then press [ENTER] until I respond"
  2971.      ZSubParm = 9
  2972.      CALL TGet
  2973. 5530 ZWasC = ZWasC + 1
  2974.      CALL Carrier
  2975.      IF ZSubParm = -1 THEN _
  2976.         EXIT SUB
  2977.      IF ZWasC = 20 THEN _
  2978.         CALL UpdtCalr ("Baud change failed",1) : _
  2979.         ZBPS = -1 : _
  2980.         CALL SetBaud : _
  2981.         EXIT SUB
  2982.      CALL DelayTime (1)
  2983. 5535 CALL EofComm (Char)
  2984.      IF Char = -1 THEN _
  2985.         GOTO 5530
  2986. 5536 CALL PutCom(ZOutTxt$)
  2987.      IF ZOutTxt$ = "" THEN _
  2988.         ZOutTxt$ = " "
  2989.      IF ASC(ZOutTxt$) = 13 THEN _
  2990.         GOTO 5540
  2991.      IF ZSubParm = -1 THEN _
  2992.         EXIT SUB
  2993. 5537 GOTO 5530
  2994. 5540 ZOutTxt$ = "Changed to 450 baud"
  2995.      CALL QuickTPut1 (ZOutTxt$)
  2996.      CALL UpdtCalr (ZOutTxt$,1)
  2997.      ZBPS = -2
  2998.      ZOutTxt$ = ""
  2999.      END SUB
  3000. 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time'
  3001. ' $PAGE
  3002. '
  3003. '  NAME    -- GetTime
  3004. '
  3005. '  INPUTS  --     PARAMETER                    MEANING
  3006. '                ZTimeLoggedOn$
  3007. '
  3008. '  OUTPUTS --  ZSessionHour               NUMBER OF HOURS ON
  3009. '              ZSessionMin                NUMBER OF MINUTES ON
  3010. '              ZSessionSec                NUMBER OF SECONDS ON
  3011. '
  3012. '  PURPOSE --  Calculate the elapsed time a user has been on
  3013. '
  3014.      SUB GetTime STATIC
  3015.      CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2)
  3016.      ZSessionHour = TempElapsed! / 3600
  3017.      ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60
  3018.      ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!)
  3019.      IF ZSessionSec < 0 THEN _
  3020.         ZSessionSec = ZSessionSec + 60 : _
  3021.         ZSessionMin = ZSessionMin - 1
  3022.      IF ZSessionMin < 0 THEN _
  3023.         ZSessionMin = ZSessionMin + 60 : _
  3024.         ZSessionHour = ZSessionHour - 1
  3025.      END SUB
  3026. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  3027. ' $PAGE
  3028. '
  3029. '  NAME    -- DefaultU
  3030. '
  3031. '  INPUTS  --     PARAMETER                    MEANING
  3032. '             ZAutoDownDesired
  3033. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  3034. '             ZCheckBulletLogon
  3035. '             ZExpertUser
  3036. '             ZWasGR
  3037. '             ZLastMsgRead
  3038. '             ZLineFeeds
  3039. '             ZNulls
  3040. '             ZPageLength
  3041. '             ZPromptBell
  3042. '             ZRegDate$
  3043. '             ZReqQuesAnswered
  3044. '             ZRightMargin
  3045. '             ZSkipFilesLogon
  3046. '             ZTimesLoggedOn
  3047. '             ZUpperCase
  3048. '             ZUserOption$
  3049. '             ZUserTextColor          Ansi of color (31-37)
  3050. '             ZUserXferDefault$
  3051. '
  3052. '  OUTPUTS--  USER.OPTONS$
  3053. '
  3054. '  PURPOSE --  To update the user's record with their options.
  3055. '  Meaning of graphics preference stored is as follows: where # is
  3056. '  value stored for the color.  E.g. if graphics perference for text
  3057. '  files is color, and preference for normal text is light yellow,
  3058. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3059. '  Blue, Purple, Cyan, and White.
  3060. '
  3061. '             normal                  bold
  3062. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3063. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3064. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3065. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3066. '
  3067.      SUB DefaultU STATIC
  3068.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  3069.             -4 * ZNulls               -8 * ZUpperCase _
  3070.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  3071.            -64 * ZSkipFilesLogon    -128 * ZAutoDownDesired _
  3072.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  3073.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser
  3074.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  3075.      IF WasX < 1 OR WasX > 255 THEN _
  3076.         WasX = 48
  3077.      LSET ZUserOption$ = _
  3078.         MKI$(ZTimesLoggedOn) + _
  3079.         MKI$(ZLastMsgRead) + _
  3080.         ZUserXferDefault$ + _
  3081.         CHR$(WasX) + _
  3082.         MKI$(ZRightMargin) + _
  3083.         MKI$(ZWasA) + _
  3084.         ZRegDate$ + _
  3085.         CHR$(ZPageLength) + _
  3086.         ZEchoer$
  3087.      END SUB
  3088. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  3089. ' $PAGE
  3090. '
  3091. '  NAME    -- WhosOn
  3092. '
  3093. '  INPUTS  --     PARAMETER                    MEANING
  3094. '                NumNodes                   # of nodes to check
  3095. '                ZActiveMessageFile$        Current message file
  3096. '                ZOrigMsgFile$              Main msg file
  3097. '
  3098. '  OUTPUTS --  None
  3099. '
  3100. '  PURPOSE --  To display who is on each node.
  3101. '
  3102.      SUB WhosOn (NumNodes) STATIC
  3103.      WasA1$ = ZActiveMessageFile$
  3104.      ZActiveMessageFile$ = ZOrigMsgFile$
  3105.      CALL OpenMsg
  3106.      FIELD 1, 128 AS ZMsgRec$
  3107.      FOR NodeIndex = 2 TO NumNodes + 1
  3108.         GET 1,NodeIndex
  3109.         ZOutTxt$ = ZFG1$ + "Node" + _
  3110.              STR$(NodeIndex - 1) + ZFG2$
  3111.         RecIndex = VAL(MID$(ZMsgRec$,44,2))
  3112.         IF RecIndex = 0 THEN _
  3113.            RecIndex = -1
  3114.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  3115.               " BAUD: "
  3116.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  3117.            ZWasY$ = "SYSOP" + SPACE$(21) _
  3118.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  3119.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  3120.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN _
  3121.            WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)
  3122.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  3123.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  3124.                 WasAX$ _
  3125.         ELSE IF NOT ZSysop THEN _
  3126.                 ZOutTxt$ = ZOutTxt$ + _
  3127.                      " Waiting for next caller" _
  3128.              ELSE ZOutTxt$ = ZOutTxt$ + _
  3129.                        " Offline at " + _
  3130.                        WasAX$
  3131.         CALL QuickTPut1 (ZOutTxt$)
  3132.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  3133.         IF ZNo THEN _
  3134.            NodeIndex = NumNodes + 2
  3135.      NEXT
  3136.      ZActiveMessageFile$ = WasA1$
  3137.      CALL QuickTPut (ZEmphasizeOff$,0)
  3138.      END SUB
  3139. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  3140. ' $PAGE
  3141. '
  3142. '  NAME    -- RecoverMsg
  3143. '
  3144. '  INPUTS  --     PARAMETER                    MEANING
  3145. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  3146. '               FirstMsgRecord        RECORD # FOR First MSG
  3147. '
  3148. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  3149. '                                         SET TO -1 IF No ERROR
  3150. '
  3151. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3152. '              possible if you have not compressed your message file
  3153. '              using config.
  3154. '
  3155.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC
  3156.       FIELD #1,128 AS ZMsgRec$
  3157.       MsgRec = FirstMsgRecord
  3158. 10420 GET 1,MsgRec
  3159.       NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  3160.       IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  3161.          ZWasY$ = "No Msg #" + _
  3162.               STR$(MsgToRecover) : _
  3163.          GOTO 10485
  3164. 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  3165.          MsgRec = MsgRec + NumRecsInMsg : _
  3166.          GOTO 10420
  3167. 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  3168.          LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  3169.                                 ZActiveMessage$ + _
  3170.                                 MID$(ZMsgRec$,117) : _
  3171.          PUT 1,LOC(1) : _
  3172.          ZWasY$ = "Restored Msg #" + _
  3173.               STR$(MsgToRecover) : _
  3174.          ActionFlag = ZTrue : _
  3175.          GOTO 10485
  3176. 10480 ZWasY$ = "Msg #" + _
  3177.            STR$(MsgToRecover) + _
  3178.            " not Dead"
  3179. 10485 CALL QuickTPut1 (ZWasY$)
  3180.       END SUB
  3181. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  3182. ' $PAGE
  3183. '  NAME    -- UpdateU
  3184. '
  3185. '  INPUTS  -- PARAMETER             MEANING
  3186. '             ZAdjustedSecurity
  3187. '             ZCurDate$
  3188. '             ZDnlds
  3189. '             ZElapsedTime
  3190. '             ZListDir
  3191. '             ZMainUserFileIndex
  3192. '             ZSecsPerSession!
  3193. '             ZUplds
  3194. '             ZUserSecLevel
  3195. '
  3196. '  OUTPUTS -- ZElapsedTime$
  3197. '             ZListNewDate$
  3198. '             ZSecLevel$
  3199. '             ZUserDnlds$
  3200. '             ZUserUplds$
  3201. '
  3202. '  PURPOSE -- Update the user record for the user when the user
  3203. '             exits RBBS-PC.
  3204. '
  3205.       SUB UpdateU (LoggingOff) STATIC
  3206.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  3207.          EXIT SUB                                                    ' KG091501
  3208.       IF ZUserFileIndex < 1 THEN _
  3209.          GOTO 10607
  3210.       UpdateDefaults = ZTrue
  3211. 10602 ZSubParm = 6
  3212.       ZWasY$ = ZLastDateTimeOn$                                      ' KG070601
  3213.       CALL FileLock
  3214.       CALL OpenUser (HighestUserRecord)
  3215.       FIELD 5,31 AS ZUserName$, _
  3216.               15 AS ZPswd$, _
  3217.                2 AS ZSecLevel$, _
  3218.               14 AS ZUserOption$,  _
  3219.               24 AS ZCityState$, _
  3220.               3 AS MachineType$, _
  3221.               4 AS ZTodayDl$, _
  3222.               4 AS ZTodayBytes$, _
  3223.               4 AS ZDlBytes$, _
  3224.               4 AS ZULBytes$, _
  3225.               14 AS ZLastDateTimeOn$, _
  3226.                3 AS ZListNewDate$, _
  3227.                2 AS ZUserDnlds$, _
  3228.                2 AS ZUserUplds$, _
  3229.                2 AS ZElapsedTime$
  3230. 10604 GET 5,ZUserFileIndex
  3231.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _                    ' KG091501
  3232.          ZUplds = ZGlobalUplds : _
  3233.          ZDnlds = ZGlobalDnlds : _
  3234.          ZDLToday! = ZGlobalDLToday! : _
  3235.          ZBytesToday! = ZGlobalBytesToday! : _
  3236.          ZDLBytes! = ZGlobalDLBytes! : _
  3237.          ZULBytes! = ZGlobalULBytes!
  3238.       LSET ZLastDateTimeOn$ = ZWasY$                                 ' KG070601
  3239.       IF UpdateDefaults THEN _
  3240.          CALL DefaultU
  3241.       IF ZListDir THEN _
  3242.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  3243.                                CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  3244.                                CHR$(VAL(MID$(ZCurDate$,4,2)))
  3245. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  3246.       LSET ZUserUplds$ = MKI$(ZUplds)
  3247.       IF ZEnforceRatios THEN _
  3248.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  3249.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  3250.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  3251.          LSET ZULBytes$ = MKS$(ZULBytes!)
  3252.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3253.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  3254.          TempElapsed! = ZElapsedTime + _
  3255.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  3256.          ZTimeCredits! = 0 _
  3257.       ELSE TempElapsed! = ZElapsedTime
  3258.       IF TempElapsed! < -32767 THEN _
  3259.          TempElapsed! = -32767 _
  3260.       ELSE IF TempElapsed! > 32767 THEN _
  3261.          TempElapsed! = 32767
  3262.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  3263.       IF ZAdjustedSecurity THEN _
  3264.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  3265.       PUT 5,ZUserFileIndex
  3266.       ZSubParm = 8
  3267.       CALL FileLock
  3268.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  3269.          ZActiveUserFile$ = ZOrigUserFile$ : _
  3270.          ZUserFileIndex = ZOrigUserFileIndex : _
  3271.          UpdateDefaults = ZFalse : _
  3272.          LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _                ' KG070601
  3273.          GOTO 10602
  3274. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  3275.          EXIT SUB
  3276.       Temp = ZMinsPerSession
  3277.       IF ZMaxPerDay > 0 THEN _
  3278.          Temp = ZMaxPerDay - TempElapsed! : _
  3279.          IF Temp > ZMinsPerSession THEN _
  3280.             Temp = ZMinsPerSession
  3281.       Temp = -(Temp > 0) * Temp
  3282.       CALL QuickTPut1 (STR$(Temp)+" min left for next call today")
  3283.       CALL QuickTPut1 (ZFirstName$ + ", Thanks and please call again!")
  3284.       IF NOT ZHiLiteOff THEN _
  3285.          CALL QuickTPut1 (ZColorReset$)
  3286.       CALL DelayTime (8 + ZBPS)
  3287.       END SUB
  3288. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  3289. ' $PAGE
  3290. '  NAME    -- DosExit
  3291. '
  3292. '  INPUTS  -- PARAMETER             MEANING
  3293. '             ZComPort$
  3294. '             ZDoorsTermType
  3295. '             ZMultiLinkPresent
  3296. '             ZRBBSBat$
  3297. '             ZRedirectIOMethod
  3298. '             ZUseDeviceDriver$
  3299. '
  3300. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3301. '                                      ZRCTTYBat$
  3302. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3303. '
  3304. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  3305. '             exit to DOS for the remote RBBS-PC sysop
  3306. '
  3307.       SUB DosExit STATIC
  3308.       IF ZMultiLinkPresent AND _
  3309.          ZDoorsTermType > 0 THEN _
  3310.          ZFF = 0 : _
  3311.          GOTO 10950
  3312.       ZOutTxt$(1) = "ECHO OFF"
  3313.       IF ZUseDeviceDriver$ <> "" THEN _
  3314.          Port$ = ZUseDeviceDriver$ _
  3315.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  3316.       IF ZRedirectIOMethod THEN _
  3317.          ZFF = 5 : _
  3318.          ZOutTxt$(2) = "CTTY " + _
  3319.                  Port$ : _
  3320.          ZOutTxt$(3) = ZDiskForDos$ + _
  3321.                  "COMMAND" : _
  3322.          ZOutTxt$(4) = "CTTY CON" : _
  3323.          ZOutTxt$(5) = ZRBBSBat$ _
  3324.       ELSE ZFF = 3 : _
  3325.            ZOutTxt$(2) = ZDiskForDos$ + _
  3326.                    "COMMAND >" + _
  3327.                    Port$ + _
  3328.                    " <" + _
  3329.                    Port$ : _
  3330.            ZOutTxt$(3) = ZRBBSBat$
  3331. 10950 CALL AMorPM
  3332.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  3333.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  3334.       CALL QuickTPut1 ("SYSOP in Remote Console Mode")
  3335.       CALL RBBSExit (ZOutTxt$(),ZFF)
  3336.       END SUB
  3337. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  3338. ' $PAGE
  3339. '  NAME    -- WordInFile
  3340. '
  3341. '  INPUTS  -- PARAMETER             MEANING
  3342. '             FilName$              FILE TO SEARCH IN
  3343. '             Strng$                STRING TO SEARCH FOR
  3344. '
  3345. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  3346. '
  3347. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  3348. '             limit doors and questionnaires to those specified
  3349. '             in their menu files.  The "Strng$" is capitalized
  3350. '             but not the lines in the file, so must be exact
  3351. '             case-sensitive match to be found.  The only character
  3352. '             that can immediately proceed or end a name to be
  3353. '             found must be a blank.
  3354. '
  3355.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  3356.       InFile = ZFalse
  3357.       CALL FindIt (FilName$)
  3358.       IF NOT ZOK THEN _
  3359.          EXIT SUB
  3360.       WasX = 0
  3361.       CALL AllCaps (Strng$)
  3362.       WHILE NOT EOF(2) AND WasX < 1
  3363.          LINE INPUT #2,ZOutTxt$
  3364.          WasY = 1
  3365. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  3366.          IF WasX < 1 THEN _
  3367.             GOTO 10980
  3368.          WasY = WasX + 1
  3369.          IF WasX > 1 THEN _
  3370.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  3371.                WasX = 0
  3372.          IF WasX > 0 THEN _
  3373.             WasL = LEN(Strng$) : _
  3374.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  3375.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  3376.                   WasX = 0
  3377.          IF WasX = 0 THEN _
  3378.             GOTO 10978
  3379. 10980 WEND
  3380.       CLOSE 2
  3381.       InFile = (WasX > 0)
  3382.       END SUB
  3383. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  3384. ' $PAGE
  3385. '  NAME    -- DoorExit
  3386. '
  3387. '  INPUTS  -- PARAMETER             MEANING
  3388. '             ZMultiLinkPresent
  3389. '             ZNodeID$
  3390. '             ZRBBSBat$
  3391. '             ZWasZ$
  3392. '
  3393. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3394. '                                      ZRCTTYBat$
  3395. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3396. '
  3397. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  3398. '             exit RBBS-PC to invoke another program
  3399. '
  3400.       SUB DoorExit (ReqDoorsDef) STATIC                              ' KG032502
  3401.       IF ZWasZ$ = "" OR _
  3402.          ZWasZ$ = "NONE" THEN _
  3403.          EXIT SUB
  3404.       CALL FindIt (ZWasZ$)
  3405.       IF NOT ZOK THEN _
  3406.          GOTO 10986
  3407.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)   ' KG032501
  3408.       ExitMethod$ = ""
  3409.       ZDooredTo$ = ExitTo$
  3410.       CALL FindIt (ZDoorsDef$)
  3411.       IF NOT ZOK THEN _
  3412.          IF ReqDoorsDef THEN _                                       ' KG032502
  3413.             EXIT SUB _                                               ' KG032502
  3414.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _                 ' KG032502
  3415.               GOTO 10989                                             ' KG032502
  3416. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  3417.       IF ZErrCode > 0 THEN _
  3418.          IF ReqDoorsDef THEN _                                       ' KG032502
  3419.             EXIT SUB _                                               ' KG032502
  3420.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _                 ' KG032502
  3421.               GOTO 10989                                             ' KG032502
  3422.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  3423.          GOTO 10985
  3424.       CALL CheckInt (ZOutTxt$(2))
  3425.       IF ZErrCode > 0 THEN _
  3426.          ZErrCode = 0 : _
  3427.          GOTO 10985
  3428.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3429.          CALL QuickTPut1 ("Insufficient security for door") : _
  3430.          EXIT SUB
  3431.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  3432.       CALL FindIt (WasX$)
  3433.       IF NOT ZOK THEN _
  3434.          GOTO 10986
  3435.       ZFileName$ = ZOutTxt$(3)
  3436.       ExitMethod$ = ZOutTxt$(4)
  3437.       ExitTemplate$ = ZOutTxt$(5)
  3438.       ZDoorDisplay$ = ZOutTxt$(7)
  3439.       DoorTime$ = ZOutTxt$(8)
  3440.       CALL AskUsers
  3441.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  3442.       CALL MetaGSR (ExitTemplate$,ZFalse)
  3443.       ExitTo$ = ExitTemplate$
  3444.       GOTO 10989
  3445. 10986 ZOutTxt$ = "Missing door program"
  3446.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  3447.       ZSnoop = ZTrue
  3448.       CALL LPrnt (ZOutTxt$,1)
  3449.       EXIT SUB
  3450. 10989 IF ZTransferFunction = 3 THEN _
  3451.          ZWasY$ = "Registration" _
  3452.       ELSE ZWasY$ = ZDooredTo$
  3453.       ZOutTxt$ = ZWasY$ + _
  3454.            " door opened at " + _
  3455.            TIME$ + _
  3456.            " on " + _
  3457.            DATE$
  3458.       ZSubParm = 5
  3459.       CALL TPut
  3460.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  3461.       CLOSE 2
  3462.       OPEN "O",2,"DORINFO" + _
  3463.                  ZNodeFileID$ + _
  3464.                  ".DEF"
  3465.       PRINT #2,ZRBBSName$
  3466.       PRINT #2,ZSysopFirstName$
  3467.       PRINT #2,ZSysopLastName$
  3468.       IF ZLocalUser THEN _
  3469.          PRINT #2,"COM0" _
  3470.       ELSE PRINT #2,ZComPort$
  3471.       ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B"))
  3472.       PRINT #2,ZTalkToModemAt$;ZUserIn$
  3473.       PRINT #2,ZNetworkType
  3474.       IF ZGlobalSysop THEN _
  3475.          PRINT #2,"SYSOP" : _
  3476.          PRINT #2,"" _
  3477.       ELSE PRINT #2,ZFirstName$ : _
  3478.            PRINT #2,ZLastName$
  3479.       PRINT #2,ZCityState$
  3480.       PRINT #2,ZWasGR
  3481.       PRINT #2,ZUserSecLevel
  3482.       CALL TimeRemain (MinsRemaining)
  3483.       CALL CheckInt (DoorTime$)
  3484.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  3485.          IF MinsRemaining > ZTestedIntValue THEN _
  3486.             MinsRemaining = ZTestedIntValue
  3487.       PRINT #2,INT(MinsRemaining)
  3488.       PRINT #2,ZFossil
  3489.       IF ExitMethod$ = "S" THEN _
  3490.          CLOSE 4 : _                                                 ' KG052401
  3491.          CALL ShellExit (ExitTemplate$) : _
  3492.          ZPrevCaller$ = "" : _                                       ' KG052401
  3493.          CALL SetCall : _                                            ' KG052401
  3494.          ZExitToDoors = ZTrue : _
  3495.          CALL BufFile (ZDoorDisplay$,WasX) : _
  3496.          CALL DoorReturn _
  3497.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  3498.                   "COMMAND /C " + _
  3499.                   ExitTo$ : _
  3500.            ZOutTxt$(2) = ZRBBSBat$ : _
  3501.            CALL RBBSExit (ZOutTxt$(),2)
  3502.       END SUB
  3503. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  3504. ' $PAGE
  3505. '  NAME    -- RBBSExit
  3506. '
  3507. '  INPUTS  -- PARAMETER             MEANING
  3508. '             LINE.ARA        Array of lines to write to batch file
  3509. '             NumLines        How many lines in array
  3510. '
  3511. '  OUTPUTS -- ZRCTTYBat$
  3512. '
  3513. '  PURPOSE -- To create a batch file that control can be passed to
  3514. '             and to exit RBBS-PC while still keeping carrier up
  3515. '
  3516.       SUB RBBSExit (LineAra$(1),NumLines) STATIC
  3517.       CLOSE 2
  3518.       IF NumLines = 0 THEN _
  3519.          GOTO 10994
  3520.       OPEN "O",2,ZRCTTYBat$
  3521.       FOR WasI = 1 TO NumLines
  3522.          IF LineAra$(WasI) <> "" THEN _
  3523.             PRINT #2,LineAra$(WasI)
  3524.       NEXT
  3525.       CLOSE 2
  3526. 10994 CLOSE 3
  3527.       ZExitToDoors = ZTrue
  3528.       IF NOT ZFossil THEN _
  3529.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  3530.       IF NOT ZPrivateDoor THEN _
  3531.          CALL MLInit (2)
  3532. 10996 CALL UpdateU (ZTrue)
  3533.       CALL GetTime
  3534.       CALL SaveProf (1)
  3535.       IF NumLines = 0 THEN _
  3536.          EXIT SUB
  3537.       CALL DelayTime (9 + ZBPS)
  3538.       IF ZFossil THEN _
  3539.          CALL FOSExit(ZComPort)
  3540.       SYSTEM
  3541.       END SUB
  3542. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  3543. ' $PAGE
  3544. '  NAME    -- SetSection         Doug Azzarito
  3545. '
  3546. '  INPUTS  -- PARAMETER             MEANING
  3547. '             ZMenuIndex      2 = user is in MAIN section
  3548. '                             3 = user is in FILE section
  3549. '                             4 = user is in UTIL section
  3550. '                             6 = user is in LIBR section
  3551. '
  3552. '  OUTPUTS -- ZSection$       4 character section name
  3553. '             ZActiveMenu$    1 character section name
  3554. '             ZSectionPrompt$ Section name (if ZShowSection config)
  3555. '             ZCmdPrompt$     Command input prompt string
  3556. '             ZSectionOpts$   List of options valid in this sect
  3557. '             ZInvalidOpts$   List of options invalid in this sect
  3558. '             ZSubSection     Index into security array for section
  3559. '
  3560. '  PURPOSE -- To build the prompt strings for the current section
  3561. '
  3562.       SUB SetSection STATIC
  3563.       IF ZMenuIndex <> 6 THEN _
  3564.          ZCurDirPath$ = ZDirPath$
  3565.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  3566. 12001 EXIT SUB
  3567. 12005 LSET ZSection$ = "FILE"
  3568.       ZSectionOpts$ = ZFileOpts$
  3569.       ZInvalidOpts$ = ZInvalidFileOpts$
  3570.       ZSubSection = ZBegFile
  3571.       GOTO 12025
  3572. 12010 LSET ZSection$ = "MAIN"
  3573.       ZSectionOpts$ = ZMainOpts$
  3574.       ZInvalidOpts$ = ZInvalidMainOpts$
  3575.       ZSubSection = ZBegMain
  3576.       GOTO 12025
  3577. 12015 LSET ZSection$ = "LIBR"
  3578.       ZSectionOpts$ = ZLibOpts$
  3579.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  3580.       ZSubSection = ZBegLibrary
  3581.       ZCurDirPath$ = ZLibDirPath$
  3582.       GOTO 12025
  3583. 12020 LSET ZSection$ = "UTIL"
  3584.       ZSectionOpts$ = ZUtilOpts$
  3585.       ZInvalidOpts$ = ZInvalidUtilOpts$
  3586.       ZSubSection = ZBegUtil
  3587. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  3588.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  3589.       IF ZShowSection THEN _
  3590.          ZSectionPrompt$ = ZSection$ _
  3591.       ELSE ZSectionPrompt$ = "Your"
  3592.       IF ZCmndsInPrompt=0 THEN _
  3593.           ZSectionOpts$ = ""
  3594.       ZCmdPrompt$ = ZSectionPrompt$ + _
  3595.                         " command" + _
  3596.                         ZSectionOpts$
  3597.       END SUB
  3598. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  3599. ' $PAGE
  3600. '
  3601. '  NAME    -- UntilRight
  3602. '
  3603. '  INPUTS  -- PARAMETER             MEANING
  3604. '             Ques$         QUESTION TO BE ASKED THE USER
  3605. '             Ans$          LOCATION TO STORE THE ANSWER
  3606. '             MinLen        MINIMUM LENGTH OF ANSWER
  3607. '             MaxLen        MAX LENGTH OF ANSWER
  3608. '
  3609. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  3610. '                                      CALLERS SAYS IS CORRECT
  3611. '
  3612. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3613. '             responds that the answer is correct
  3614. '
  3615.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  3616. 12880 ZSubParm = 1
  3617.       ZOutTxt$ = Ques$
  3618.       CALL TGet
  3619.       IF ZSubParm = -1 THEN _
  3620.          GOTO 12882
  3621.       IF ZWasQ = 0 THEN _
  3622.          GOTO 12880
  3623.       IF LEN(ZUserIn$(1)) > MaxLen THEN _
  3624.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  3625.          GOTO 12880_
  3626.       ELSE IF LEN(ZUserIn$(1)) < MinLen THEN _
  3627.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  3628.               GOTO 12880
  3629.       Ans$ = ZUserIn$(1)
  3630.       ZOutTxt$ = ZUserIn$(1) + _
  3631.            ", right ([Y],N)"
  3632.       ZTurboKey = -ZTurboKeyUser
  3633.       ZSubParm = 1
  3634.       CALL TGet
  3635.       IF ZSubParm = -1 THEN _
  3636.          GOTO 12882
  3637.       IF ZNo THEN _
  3638.          GOTO 12880
  3639.       CALL AllCaps (Ans$)
  3640.       EXIT SUB
  3641. 12882 Ans$ = "GUEST"
  3642.       END SUB
  3643. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  3644. ' $PAGE
  3645. '
  3646. '  NAME    -- LogError
  3647. '
  3648. '  INPUTS  --     PARAMETER                    MEANING
  3649. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3650. '                    ERL           Last LINE NUMBER ENCOUNTERED
  3651. '                                  PRIOR TO ENCOUNTERNING ERROR
  3652. '
  3653. '  OUTPUTS -- NONE
  3654. '
  3655. '  PURPOSE -- To set up a string to write to the callers log
  3656. '             indicating the date, time, error, and error line
  3657. '
  3658.       SUB LogError STATIC
  3659.       WasIX = ERR
  3660.       IF ERR < 1 THEN _
  3661.          WasIX = ZErrCode
  3662.       CALL UpdtCalr("+++ Error " + _
  3663.            STR$(WasIX) + _
  3664.            " line " + _
  3665.            STR$(ERL) + _
  3666.            " at " + _
  3667.            TIME$ + _
  3668.            " on " + _
  3669.            DATE$,2)
  3670.       END SUB
  3671. '
  3672. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  3673. ' $PAGE
  3674. '
  3675. '  NAME    -- CheckRatio
  3676. '
  3677. '  INPUTS  --   PARAMETER                    MEANING
  3678. '               TellUser           TELL USER THEIR RATIO
  3679. '               ZDnlds             FILES DOWNLOADED
  3680. '               ZDLBytes!          BYTES DOWNLOADED
  3681. '               ZUplds             FILES UPLOADED
  3682. '               ZULBytes!          BYTES UPLOADED
  3683. '
  3684. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  3685. '
  3686. '  PURPOSE -- To determine whether the users violated
  3687. '             their upload to download restriction
  3688. '
  3689.       SUB CheckRatio (TellUser) STATIC
  3690.       ZOK = ZTrue
  3691.       IF NOT ZEnforceRatios THEN _
  3692.          GOTO 20110
  3693.       IF ZRatioRestrict# <= 0 THEN _
  3694.          GOTO 20110
  3695. '
  3696. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  3697. '
  3698.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  3699.          Method$ = "Bytes" : _
  3700.          ULWork# = ZULBytes! : _
  3701.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  3702.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  3703.          Method$ = "Files" : _
  3704.          ULWork# = ZUplds : _
  3705.          DLWork# = ZDnlds + ZDownFiles
  3706.       IF ULWork# < ZInitialCredit# THEN _
  3707.          ULWork# = ZInitialCredit#
  3708.       IF ZByteMethod = 2 THEN _
  3709.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  3710.       IF ZByteMethod = 3 THEN _
  3711.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  3712. '
  3713.       Ratio# = 0
  3714.       RatioSuffix$ = ":0"
  3715.       IF ULWork# > 0 THEN _
  3716.          Ratio# = (DLWork# / ULWork#) : _
  3717.          RatioSuffix$ = ":1"
  3718.       IF ZByteMethod > 1 THEN _
  3719.          ZOutTxt$ = "Today Downloaded Files: " + STR$(ZDLToday! + ZDownFiles) + _
  3720.               "  Bytes:" + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  3721.          ZSubParm = 5 : _
  3722.          CALL TPut : _
  3723.          CALL SkipLine (1) : _
  3724.          GOTO 20100
  3725.       WasX$ = STR$(Ratio#)
  3726.       X = INSTR(WasX$,".")
  3727.       IF X > 0 THEN _
  3728.          WasX$ = LEFT$(WasX$,X+1)
  3729.       ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _
  3730.               " Uploaded:" + _
  3731.               STR$(ULWork#) + _
  3732.               " Ratio:" + _
  3733.               WasX$ + _
  3734.               RatioSuffix$
  3735.       ZSubParm = 5
  3736.       CALL TPut
  3737. '
  3738. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3739. '
  3740. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  3741.          EXIT SUB
  3742.       IF ZByteMethod <= 1 THEN _
  3743.          GOTO 20105
  3744.       IF Today# < 0 THEN _
  3745.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  3746.               STR$(ZRatioRestrict#) + " " + _
  3747.               Method$ + " Reached" : _
  3748.          ZOK = ZFalse _
  3749.       ELSE ZOutTxt$ = "Download balance:" + _                        ' KG071301
  3750.                 STR$(Today#) + _
  3751.                 " " + _
  3752.                 Method$ : _
  3753.            ZOK = ZTrue
  3754.       ZSubParm = 5
  3755.       CALL TPut
  3756.       CALL SkipLine(1)
  3757.       EXIT SUB
  3758. '
  3759. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  3760.          ZOK = ZFalse : _
  3761.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  3762.               STR$(ZRatioRestrict#) + _
  3763.               ":1 " + _
  3764.               Method$ + " exceeded" : _
  3765.          ZSubParm = 5 : _
  3766.          CALL TPut : _
  3767.          ZOutTxt$ = "Minimum upload of" + _
  3768.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  3769.               / ZRatioRestrict#) + 1)) + _
  3770.               + " " + Method$ + " required to download" _
  3771.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  3772.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  3773.                 " " + Method$
  3774.       ZSubParm = 5
  3775.       CALL TPut
  3776.       CALL SkipLine (1)
  3777. 20110 END SUB
  3778. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  3779. ' $PAGE
  3780. '
  3781. '  NAME    -- GetArc
  3782. '
  3783. '  INPUTS  --     PARAMETER                    MEANING
  3784. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  3785. '                 ZUserIn$()                  ENTRIES TYPED
  3786. '
  3787. '  OUTPUTS --
  3788. '
  3789. '  PURPOSE --  Process the V)erbose list command.
  3790. '              Takes what user types and tries to list it.
  3791. '
  3792.       SUB GetArc STATIC
  3793. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  3794.          IF LEN(ZDefaultExtension$) > 0 THEN _                       ' KG080101
  3795.             CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$) ' KG080101
  3796.       ZOutTxt$ = "What compressed file(s)" + ZPressEnterExpert$
  3797.       CALL PopCmdStack
  3798.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3799.          EXIT SUB
  3800. 20142 ZViolation$ = "View ARC"
  3801.       WasX = ZAnsIndex
  3802.       FOR ZAnsIndex = WasX TO ZLastIndex
  3803.          GOSUB 20143
  3804.          IF ZSubParm < 0 THEN _
  3805.             ZAnsIndex = ZLastIndex + 1
  3806.       NEXT
  3807.       IF ZLastIndex > 1 THEN _
  3808.          EXIT SUB _
  3809.       ELSE GOTO 20141
  3810. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  3811.       WasZ$ = ZWasZ$                                                 ' KG022205
  3812.       CALL AllCaps (ZWasZ$)
  3813.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  3814.       IF Ext$ = "" THEN _
  3815.          Ext$ = ZDefaultExtension$ : _
  3816.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  3817.       ZFileNameHold$ = ZWasZ$
  3818.       ZFileName$ = ZWasZ$
  3819.       CALL BadFile (Prefix$,BadFileNameIndex)
  3820.       ON BadFileNameIndex GOTO 20144,20146,20147
  3821. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  3822.       ON BadFileNameIndex GOTO 20145,20146,20147
  3823. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") ' KG022204
  3824.       IF ZOK THEN _
  3825.          GOTO 20148
  3826. 20146 ZWasZ$ = WasZ$ + _                                             ' KG022205
  3827.            " not found!"
  3828.       CALL UpdtCalr (ZWasZ$,2)
  3829.       ZOutTxt$ = ZWasZ$ + _
  3830.            " Type correct filename" + ZPressEnterExpert$
  3831.       ZSubParm = 1
  3832.       CALL TGet
  3833.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3834.          RETURN
  3835.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  3836.       GOTO 20143
  3837. 20147 CALL SecViolation
  3838.       IF ZDenyAccess THEN _
  3839.          EXIT SUB
  3840.       GOTO 20146
  3841. 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT"
  3842.       CALL FindIt (WasX$)
  3843.       IF NOT ZOK THEN _
  3844.          GOTO 20150
  3845.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  3846.       CALL ReadDir (2,1)
  3847.       IF EOF(2) THEN _
  3848.          ZWasZ$ = ZOutTxt$ : _
  3849.          ZGSRAra$(1) = ZFileName$ : _
  3850.          ZGSRAra$(2) = ZArcWork$ _
  3851.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  3852.                 " " + ZArcWork$ + " " + ZGSRAra$(3)
  3853.       CALL ShellExit (ZWasZ$)
  3854.       CALL BufFile (ZArcWork$,WasX)
  3855.       RETURN
  3856. 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
  3857.       'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
  3858.       IF (WasX < 1) THEN _
  3859.          CALL QuickTPut1 ("View for "+Ext$+" not implemented") : _
  3860.          RETURN
  3861.       CALL QuickTPut1 (ZFileNameHold$ + " has these files")
  3862.       CALL ViewArc
  3863.       RETURN
  3864.       END SUB
  3865. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  3866. ' $PAGE
  3867. '
  3868. '  NAME    -- BadName
  3869. '
  3870. '  INPUTS  --     PARAMETER                    MEANING
  3871. '               ZActiveMessageFile$
  3872. '               ZActiveUserFile$
  3873. '               ZCallersFile$
  3874. '               ZCmntsFile$
  3875. '               CONFIG.FILEANAME$
  3876. '               ZMainMsgBackup$
  3877. '               ZMainMsgFile$
  3878. '               ZMaxViolations
  3879. '               ZPswdFile$
  3880. '               ZRBBSBat$
  3881. '               ZRCTTYBat$
  3882. '               ZSubDir$()
  3883. '               ZSubDirIndex
  3884. '               ZViolation$
  3885. '               ZViolationsThisSession
  3886. '               ZWasZ$                          NAME OF FILE
  3887. '               ProtectExt              -1 if check for extension alone
  3888. '                                        0 to allow any extension
  3889. '
  3890. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  3891. '                                       2 = SECURITY BREACH TRIED    ' KG101201
  3892. '
  3893. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  3894. '             to either crash the system or to breach RBBS-PC's security
  3895. '
  3896.       SUB BadName (BadFileNameIndex,ProtectExt) STATIC               ' KG101201
  3897. '
  3898. '
  3899. ' *  TEST FOR SYSTEM FILE ATTEMPT
  3900. '
  3901.       BadFileNameIndex = 2
  3902.       ZWasZ$ = ZFileName$
  3903.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  3904.       IF LEN(Extension$) = 3 AND ProtectExt THEN _                   ' KG101201
  3905.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  3906.             EXIT SUB
  3907.       ZOK = 0
  3908.       CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  3909.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  3910.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  3911.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  3912.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  3913.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  3914.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  3915.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  3916.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  3917.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  3918.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  3919.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  3920.       IF ZOK = 0 THEN _                                              ' KG101201
  3921.          BadFileNameIndex = 1                                        ' KG101201
  3922.       END SUB
  3923. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  3924. ' $PAGE
  3925. '
  3926. '  NAME    -- FileNameCheck
  3927. '
  3928. '  INPUTS  --     PARAMETER                    MEANING
  3929. '               CheckThis$           Name of file to check
  3930. '               Pref2$               Prefix to match against
  3931. '               Ext2$                Extension to match against
  3932. '
  3933. '  OUTPUTS  -- ZOK                    1 if got match
  3934. '
  3935. '  PURPOSE -- Checks for match on both prefix and extension of a file
  3936. '             name.   Used to catch match on system files not to be
  3937. '             downloaded.
  3938. '
  3939.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  3940.       IF ZOK > 0 THEN _
  3941.          EXIT SUB
  3942.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  3943.       IF Pref1$ = Pref2$ THEN _
  3944.          IF Ext1$ = Ext2$ THEN _
  3945.             ZOK = 1
  3946.       END SUB
  3947.  
  3948.